With significant helpful contributions from Beate Henschel and Stephanie Dickinson.

Measures

# Save outcomes and their labels at top for tables, plots, and analysis

outcome_pairs = as.data.frame(outcomes <- rbind(
  # Dietary quality
  # Change in ASA24 HEI Diet Quality Scores (Total and Subscores)  1:14
  c("HEI2015_TOTAL_SCORE_change",  "HEI Total Score"),
  c("HEI2015C1_TOTALVEG_change", "Total Vegetable"),
  c("HEI2015C2_GREEN_AND_BEAN_change",  "Greens and Beans"),
  c("HEI2015C3_TOTALFRUIT_change","Total Fruit"),
  c("HEI2015C4_WHOLEFRUIT_change", "Whole Fruit"),
  c("HEI2015C5_WHOLEGRAIN_change", "Whole Grains"),
  c("HEI2015C6_TOTALDAIRY_change", "Total Dairy"),
  c("HEI2015C7_TOTPROT_change", "Total Protein Foods"),
  c("HEI2015C8_SEAPLANT_PROT_change", "Seafood and Plant Proteins"),
  c("HEI2015C9_FATTYACID_change", "Fatty Acids"),
  c("HEI2015C10_SODIUM_change", "Sodium"),
  c("HEI2015C11_REFINEDGRAIN_change", "Refined Grains"),
  c("HEI2015C12_SFAT_change","Saturated Fats"),
  c("HEI2015C13_ADDSUG_change","Added Sugars"),
  # Other Dietary Quality Measures 15
  c("amed_change", "AMED Score"),
  # Change in Average Micro and Macro Nutrients Between Endline and Baseline 16:24
  c("KCAL_ave_change", "Average Total Energy"),
  c("TFAT_ave_change", "Average Total Fat"),
  c("CARB_ave_change", "Average Total Carbohydrates"),
  c("SODI_ave_change", "Average Sodium"),
  c("SFAT_ave_change", "Average Saturated Fats"),
  c("SUGR_ave_change", "Average Total Sugars"),
  c("ADD_SUGARS_ave_change", "Average Added Sugars"),
  c("CHOLE_ave_change", "Average Total Cholesterol"),
  c("FIBE_ave_change", "Average Fiber"),
  # Weight loss
  # Weight Loss Measures 25:30
  c("weightkg_change", "Body Weight (kg)"),
  c("BMI_change", "BMI"),
  c("changekg_percent_body_wt", "Percent Body Weight Change"),
  c("achieve_3_percent_wl", "Achieved 3% Weight Loss"),
  c("achieve_5_percent_wl", "Achieved 5% Weight Loss"),
  c("achieve_10_percent_wl","Achieved 10% Weight Loss"),
  # Behavioral
  # Change in Physical Activity 31:34
  c("METS_change","Total Physical Activity MET"),
  c("sendentary_change", "Sedentary"),
  c("moderate_change", "Moderate"),
  c("vigorous_change", "Vigorous"),
  # Change in Self-Reported Sleep 35:37
  c("sleep_quality_change", "Sleep Quality"),
  c("sleep_amount_change",  "Usual Sleep Amount"),
  c("wake_episodes_change","Wake Episodes"),
  # Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy) 38:52
  c("SRBAI_change", "SRBAI Habit Strength"),
  c("Avg1_change", "Considering Portion Sizes"),
  c("Avg2_change", "Tracking Food Consumption"),
  c("Avg3_change", "Consider WW Points"),
  c("Avg4_change", "Frequency of Eating Vegetables"),
  c("Avg5_change", "Frequency of Weighing Self"),
  c("Avg6_change", "Frequency of Physical Activity"),
  c("Avg7_change", "Talking Kindly to Self After Setback"),
  c("Avg8_change", "Arranging Healthy Foods for Easy Access"),
  c("Avg9_change", "Frequency of Fried Foods"),
  c("Avg10_change", "Frequency of Sweets"),
  c("Avg11_change", "Frequency of Sugary Beverages"),
  c("Avg12_change", "Snacking When Not Hungry"),
  c("UnhSRBAI_change", "Unhealthy Grouped"),
  c("healSRBAI_change","Healthy Grouped")
))

colnames(outcome_pairs) = c("outcomes", "outcome_labels")
outcomes <- outcome_pairs$outcomes

# indices:
# 1:15, 16:24, 25:30, 31:34, 35:37, 38:52

Note: Change scores are calculated as endline minus baseline measurements.

Outcomes

Dietary Quality

  • Change in Diet Quality (difference between baseline and 6-mo HEI-2015 total and sub scores): Diet quality is calculated with the Healthy Eating Index-2015 (HEI-2015). The HEI-2015, is a valid and reliable composite measure that assesses overall diet quality and compliance with the DGA-2015. This tool can help assess diet quality from U.S. populations and racial and ethnic subgroups. The HEI-2015 scores 13 key dietary components to obtain a total score ranging from 0-100. Higher scores reflect greater dietary quality/greater adherence to the Dietary Guidelines (USDA, HEI-2015). Diet quality scores will be calculated by combining across 3 unannounced 24h dietary recalls collected using the Automated Self-Administered 24-Hour Dietary Assessment Tool (ASA-2413). HEI-2015 total scores will be calculated using the “Simple HEI Scoring Algorithm – Per Person” method using the instructions and SAS macro (hei2015.score.macro.sas) (https://epi.grants.cancer.gov/hei/sas-code.html).

  • Change in Alternative Mediterranean Diet Score: The alternative Mediterranean diet score (AMED) score was modified and adapted to the Mediterranean diet scale designed by Trichopoulou et al. The AMED score is made up of 9 components: seven “healthy” components: a. fruits, b. vegetables, c. fish, d. legumes, e. nuts, f. whole grains, and g. ratio of monounsaturated fat to saturated fat, and two additional components: h. red and processed meat, and i. alcohol consumption as described by Dr. Zhilei Shan et al. Each component, except alcohol, will be categorized into quintiles (Q). Positive scores to the seven healthy components will be assigned as follows: (Q1=1, Q2=2, Q3=3, Q4=4, Q5=5). Reverse scores to red and processed meat will be assigned as follows: (Q5=1, Q4=2, Q3=3, Q2=4, Q1=5). For alcohol consumption (g/d), points will be assigned as follows: 5-15=5, 0-5 or 15-25=4, 0 or 25-30=3, 30-35=2, and ≥35=1 for females and 10-30=5, 0-10 or 30-40=4, 0 or 40-45=3, 45-50=2, and ≥50=1 for males. The analysis will use the total AMED composite score, ranging from 9 to 45, with a higher score representing closer resemblance to a healthy Mediterranean diet. Data collected at baseline and 6-months; outcome is change in scores.

  • Dietary Intake: Macro- and micro-nutrient intakes measured with the validated Automated Self-Administered 24-hour (ASA24®) Dietary Assessment Tool (averaged across the number of recalls) including total energy, total fat, total carbohydrates, sodium, saturated fats, total and added sugars, total cholesterol, and fiber.

Weight Loss

  • Body weight change (kg)

  • Change in BMI, where BMI = \(\text{weight} / \text{height_bl}^2 \times 703\)

  • Percent (%) Body Weight Loss: Weight (lb); % body weight loss defined as baseline to 6-month weight change divided by baseline weight multiplied by 100.

  • Achievement of 3, 5, and 10% Weight Loss: Participants that achieve at least 3/5/10% body weight loss at 6 months or not.

Behavioral

  • Change in Self-Reported Physical Activity Over the Past 7 Days: Measured using the Global Physical Activity Questionnaire (GPAQ) which collects information on physical activity participation in the following domains: activity at work, travel to-and from- places, recreational activities, and sedentary behavior. From these inputs, the MET minutes per week spent in moderate activity, vigorous activity, moderate and vigorous activity, and sedentary behavior can be calculated. Data collected at baseline and 6-months; outcome is change in scores.

  • Self-Reported Sleep Quality: Measured with the sleep assessment module from the validated Automated Self-Administered 24-hour (ASA24®) Dietary Assessment Tool.

    • Sleep Quality is measured on a scale from 1-5 where 1 means very good sleep quality and 5 is very poor sleep quality.

    • Usual Sleep Amount is measured on a scale of 1-3 where 1 means much more sleep than usual, 2 is usual amount of sleep, and 3 means much less sleep than usual.

    • Wake Episodes measured how many times a participant woke up, not counting final time they woke up.

  • Change in Habit Strength: Measured using the Self-Reported Behavioral Automaticity Index (SRBAI), which captures habitual patterns of behavior. Each behavior of interest is assessed by 4 items rated on a Likert scale 1-strongly disagree to 7-strongly agree. Scores are calculated for each behavior by taking an average of the response, creating a possible score range between 1 and 7. Higher scores indicate greater habit strength for the behavior being measured. Data collected at baseline and 6-months; outcome is change in scores.

Note: Change scores are calculated as endline minus baseline measurements.

Covariates

  • Age, yrs

  • Self-reported Race (American Indian/Alaska Native, Asian, Black or African-American, Multiracial, White, Other Not Listed, Prefer not to say, White)

  • Self-identified as Hispanic, Latinx, Latine, or Spanish (Yes, No)

  • Sex assigned at birth (Male or Female)

  • Education (highest level achieved): Some high school, High school degree/GED/equivalent, Trade school or specialty training, Some college, Associates degree, Bachelor’s degree, Some graduate school, Master’s degree, Professional degree or doctorate.

Additional Variables

  • Self-reported Gender (Female, Male, Trans/Non-Binary/Third Gender)

  • Self-reported total household income (before taxes): <$10,000, $10,000-$19,999, $20,000-$29,999, $30,000-$39,999, $40,000-$49,999, $50,000-$59,999, $60,000-$69,999, $70,000-$79,999, $80,000-$89,999, $90,000-$99,999, $100,000-$149,999, >$150,000

  • Weight and BMI at baseline, endline, and change scores as well as total calories at baseline from DietID were considered for inclusion in imputation to help inform the data, but were not used in any analysis models.

  • Food insecurity in the past 12 month, measured only at endline.

Descriptive Statistics

Descriptive statistics will include means and standard deviations for each continuous variable, as well as counts and proportions for the categorical variables. All Descriptive Statistics in this section are based on raw/observed (unimputed) data.

Table 1 - Baseline

Sociodemographic characteristics of study participants at baseline

# save data for table separately for tables without throwing off models:
data_tab <- raw_data

# Order factor levels and change labels:
data_tab$Income_grouped <- factor(data_tab$Income_grouped,
                                  levels = c("<$60k",
                                             ">=$60k to <$100K", ">=$100k"),
                                  labels = c(" $59,999 or under", 
                                             "Between $60,000 and $99,999",
                                             "$100,000 or above"),
                                  ordered = TRUE)

data_tab$Education_grouped <- factor(data_tab$Education_grouped,
                                     levels = c("<=Associates",
                                                "Bach/Some Grad", ">=Masters"),
                                     labels = c("Associate degree or below",
                                                "Bachelor’s degree and some graduate school",
                                                "Masters or above"),
                                     ordered = TRUE)

data_tab$Race2_bcf <- factor(data_tab$Race2_bcf,
                             levels = c("Asian", "Black or African-American",
                                        "White",
                                        "Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say"),
                             ordered = TRUE)

data_tab$foodinsec <- factor(data_tab$foodinsec, 
                             levels = c(0, 1),
                             labels = c("No", "Yes")) 

# Add nice labels for table:
table1::label(data_tab$Age_years) <- "Age, years"
table1::label(data_tab$Sex_bcf) <- "Sex assigned at birth"
table1::label(data_tab$Gender_grouped) <- "Self-identified gender"
table1::label(data_tab$Race2_bcf) <- "Self-identified race"
table1::label(data_tab$Ethnicity_bcf) <- "Self-identified as Hispanic, Latinx, Latine, or Spanish"
table1::label(data_tab$Income_grouped) <- "Household Income, USD"
table1::label(data_tab$Education_grouped) <- "Highest level of education achieved"
table1::label(data_tab$BMI_bl) <- "BMI"
table1::label(data_tab$HEI2015_TOTAL_SCORE_bl) <- "Diet quality, HEI-2015"
table1::label(data_tab$amed_bl) <- "aMED"
table1::label(data_tab$foodinsec) <- "Food insecurity"


# generate table 1:
table1(~ Age_years + Sex_bcf + Gender_grouped + Race2_bcf + Ethnicity_bcf + Income_grouped + Education_grouped + BMI_bl + HEI2015_TOTAL_SCORE_bl + amed_bl + foodinsec | Treatment, data = data_tab,
       render.continuous = for.cont.variables)
Weight Watchers
(N=187)
Control
(N=189)
Overall
(N=376)
Age, years
Mean (SD) 47.60 (12.14) 47.87 (12.33) 47.73 (12.22)
Sex assigned at birth
Female 149 (79.7%) 149 (78.8%) 298 (79.3%)
Male 38 (20.3%) 40 (21.2%) 78 (20.7%)
Self-identified gender
Female 146 (78.1%) 147 (77.8%) 293 (77.9%)
Male 39 (20.9%) 41 (21.7%) 80 (21.3%)
Non-binary / third gender / Transgender 2 (1.1%) 1 (0.5%) 3 (0.8%)
Self-identified race
Asian 14 (7.5%) 14 (7.4%) 28 (7.4%)
Black or African-American 24 (12.8%) 28 (14.8%) 52 (13.8%)
White 139 (74.3%) 133 (70.4%) 272 (72.3%)
Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say 10 (5.3%) 14 (7.4%) 24 (6.4%)
Self-identified as Hispanic, Latinx, Latine, or Spanish
No 176 (94.1%) 164 (86.8%) 340 (90.4%)
Yes 11 (5.9%) 25 (13.2%) 36 (9.6%)
Household Income, USD
$59,999 or under 52 (27.8%) 47 (24.9%) 99 (26.3%)
Between $60,000 and $99,999 60 (32.1%) 63 (33.3%) 123 (32.7%)
$100,000 or above 75 (40.1%) 79 (41.8%) 154 (41.0%)
Highest level of education achieved
Associate degree or below 53 (28.3%) 63 (33.3%) 116 (30.9%)
Bachelor’s degree and some graduate school 72 (38.5%) 61 (32.3%) 133 (35.4%)
Masters or above 62 (33.2%) 65 (34.4%) 127 (33.8%)
BMI
Mean (SD) 33.64 (4.60) 33.65 (4.78) 33.64 (4.68)
Missing 1 (0.5%) 0 (0%) 1 (0.3%)
Diet quality, HEI-2015
Mean (SD) 55.35 (12.26) 55.22 (12.47) 55.28 (12.35)
aMED
Mean (SD) 27.17 (5.33) 27.12 (5.23) 27.14 (5.27)
Food insecurity
No 125 (66.8%) 135 (71.4%) 260 (69.1%)
Yes 27 (14.4%) 40 (21.2%) 67 (17.8%)
Missing 35 (18.7%) 14 (7.4%) 49 (13.0%)

Diet Quality, HEI-2015 was collected from three ASA24 dietary recalls.

Food insecurity was captured at endline because it was not asked at baseline. BMI and diet quality are baseline measurements.

Note: When variables are included as covariates in the analysis, they’re grouped as has been done in Table 1. Age, race, ethnicity, sex assigned at birth, and education are included as covariates in the models as well as a baseline measure of the outcome being analyzed and treatment as the exposure variable.

Significance tests for baseline differences will not be conducted per CONSORT guidelines (Schulz, 2010).


Race x Hispanic Status

Let’s take a closer look at the breakdown of race and ethnicity overall:

kable(xtabs(~ Race_bcf + Ethnicity_bcf, raw_data)) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 1, "Ethnicity" = 2)) %>%
  pack_rows(index = c("Race" = 7)) 
Ethnicity
No Yes
Race
American Indian/Alaska Native 2 1
Asian 28 0
Black or African-American 52 0
Multiracial 7 3
Other Not Listed 3 5
Prefer not to say 1 2
White 247 25

Simply divide these by the total sample size (n=376) to get percents.

Table 2 - Outcomes

Outcomes tables for Descriptive Statistics by Outcome

Note: Change scores are calculated as endline minus baseline measurements.

# Reformat data with timepoint variable for bl, el, and ch (3 rows per applicable outcome)
outcomes_tab_data <- data_tab %>% dplyr::select(!c(Income_grouped, Gender_grouped, Race_bcf, Race2_bcf,
                                                   Age_years, Sex_bcf,
                                                   Ethnicity_bcf, Education_bcf, Education_grouped,
                                                   Income_bcf, Income_grouped, foodinsec, 
                                                   changekg_percent_body_wt,
                                                   achieve_3_percent_wl, 
                                                   achieve_5_percent_wl, 
                                                   achieve_10_percent_wl, Treatment))
colnames(outcomes_tab_data) = gsub("_change", "_ch", colnames(outcomes_tab_data))

outcomes_tab_data_long<-pivot_longer(outcomes_tab_data, cols=-1, names_pattern = "(.*)_(..)$", names_to = c("Outcome", "Timepoint")) 

outcomes_tab_data_wide <-pivot_wider(outcomes_tab_data_long, id_cols = c(WINS.ID, Timepoint), names_from = Outcome, values_from = value)

# add outcomes only at endline after:
add_on <- data_tab %>% dplyr::select(WINS.ID, foodinsec, changekg_percent_body_wt, 
                              achieve_3_percent_wl, achieve_5_percent_wl, achieve_10_percent_wl) %>% mutate(Timepoint = "el")

outcomes_tab_data_wide = merge(outcomes_tab_data_wide, add_on, by = c("WINS.ID", "Timepoint"), all = TRUE)
outcomes_tab_data_wide = merge(outcomes_tab_data_wide, raw_data[,c("WINS.ID", "Treatment")], 
                          by = c("WINS.ID"), all = TRUE)

# change to nice labels and order for appearance in table
outcomes_tab_data_wide$Timepoint[outcomes_tab_data_wide$Timepoint == "bl"] = "Baseline"
outcomes_tab_data_wide$Timepoint[outcomes_tab_data_wide$Timepoint == "el"] = "Endline"
outcomes_tab_data_wide$Timepoint[outcomes_tab_data_wide$Timepoint == "ch"] = "Change"
outcomes_tab_data_wide$Timepoint <- factor(outcomes_tab_data_wide$Timepoint, 
                                           levels = c("Baseline", "Endline", "Change"))

Dietary quality

# Change in HEI Diet Quality Scores

# Nice labels for table
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015_TOTAL_SCORE"] = "HEI Total Score"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C1_TOTALVEG"] = "Total Vegetable"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C2_GREEN_AND_BEAN"] = "Greens and Beans"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C3_TOTALFRUIT"] = "Total Fruit"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C4_WHOLEFRUIT"] = "Whole Fruit"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C5_WHOLEGRAIN"] = "Whole Grains"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C6_TOTALDAIRY"] = "Total Dairy"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C7_TOTPROT"] = "Total Protein Foods"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C8_SEAPLANT_PROT"] = "Seafood and Plant Proteins"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C9_FATTYACID"] = "Fatty Acids"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C10_SODIUM"] = "Sodium"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C11_REFINEDGRAIN"] = "Refined Grains"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C12_SFAT"] = "Saturated Fats"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "HEI2015C13_ADDSUG"] = "Added Sugars"

datasummary(
  (`HEI Total Score` + `Total Vegetable` + `Greens and Beans` +`Total Fruit`+`Whole Fruit`+`Whole Grains`+`Total Dairy`+
  `Total Protein Foods`+`Seafood and Plant Proteins`+`Fatty Acids`+`Sodium`+`Refined Grains`+`Saturated Fats`+`Added Sugars`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide, title = "Change in ASA24 HEI Diet Quality Scores (Total and Subscores)"
)
Weight Watchers Control
Change in ASA24 HEI Diet Quality Scores (Total and Subscores)
Timepoint N Mean SD N Mean SD
HEI Total Score Baseline 187 55.35 12.26 189 55.22 12.47
Endline 160 59.38 12.68 181 55.22 13.00
Change 160 3.94 14.01 181 -0.06 13.03
Total Vegetable Baseline 187 3.76 1.30 189 3.71 1.32
Endline 160 3.97 1.21 181 3.82 1.38
Change 160 0.21 1.42 181 0.10 1.34
Greens and Beans Baseline 187 3.16 1.95 189 2.93 2.00
Endline 160 3.62 1.87 181 2.95 2.11
Change 160 0.54 2.43 181 -0.00 2.42
Total Fruit Baseline 187 2.03 1.78 189 2.02 1.79
Endline 160 2.55 2.00 181 2.04 1.81
Change 160 0.52 2.06 181 -0.00 1.86
Whole Fruit Baseline 187 2.62 2.05 189 2.55 2.08
Endline 160 3.03 2.23 181 2.49 2.05
Change 160 0.37 2.25 181 -0.11 2.15
Whole Grains Baseline 187 3.11 3.16 189 2.97 3.01
Endline 160 3.47 3.59 181 3.00 3.14
Change 160 0.26 3.80 181 -0.01 3.84
Total Dairy Baseline 187 5.33 2.75 189 5.70 2.77
Endline 160 5.21 3.04 181 5.55 2.85
Change 160 -0.18 3.24 181 -0.13 3.35
Total Protein Foods Baseline 187 4.68 0.81 189 4.72 0.75
Endline 160 4.80 0.60 181 4.78 0.59
Change 160 0.11 0.99 181 0.06 0.78
Seafood and Plant Proteins Baseline 187 3.63 1.88 189 3.47 1.96
Endline 160 3.44 1.96 181 3.32 2.01
Change 160 -0.18 2.59 181 -0.15 2.22
Fatty Acids Baseline 187 4.77 3.33 189 4.80 3.04
Endline 160 5.33 3.31 181 5.08 3.12
Change 160 0.63 4.14 181 0.33 3.72
Sodium Baseline 187 2.98 2.83 189 3.26 2.80
Endline 160 2.42 2.70 181 2.67 2.81
Change 160 -0.67 3.17 181 -0.62 3.19
Refined Grains Baseline 187 6.70 2.94 189 6.91 2.96
Endline 160 7.48 3.09 181 6.43 3.40
Change 160 0.81 3.60 181 -0.45 4.09
Saturated Fats Baseline 187 4.28 3.19 189 4.12 2.96
Endline 160 5.26 3.47 181 4.67 3.11
Change 160 1.09 4.05 181 0.52 3.44
Added Sugars Baseline 187 8.29 2.11 189 8.07 2.32
Endline 160 8.79 2.18 181 8.42 2.20
Change 160 0.43 2.30 181 0.38 2.43

The first nine subcomponents (Total Vegetable to Fatty Acids) are adequacy components where higher component scores indicate higher consumption (higher ratio for fatty acids). The last four components (Sodium to Added Sugars) are moderation components where higher component scores indicate lower consumption.

# additional diet quality measure

# Nice labels for table
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "amed"] = "AMED Score"

datasummary(
  (`AMED Score`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide, title = "Other Dietary Quality Measures"
)
Weight Watchers Control
Other Dietary Quality Measures
Timepoint N Mean SD N Mean SD
AMED Score Baseline 187 27.17 5.33 189 27.12 5.23
Endline 160 27.24 5.61 181 26.66 5.58
Change 160 -0.09 5.59 181 -0.45 5.33
# Change ASA24 Micro- and Macro Nutrients

# Nice labels for table
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "KCAL_ave"] = "Average Total Energy"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "TFAT_ave"] = "Average Total Fat"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "CARB_ave"] = "Average Total Carbohydrates"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "SODI_ave"] = "Average Sodium"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "SFAT_ave"] = "Average Saturated Fats"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "SUGR_ave"] = "Average Total Sugars"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "ADD_SUGARS_ave"] = "Average Added Sugars"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "CHOLE_ave"] = "Average Total Cholesterol"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "FIBE_ave"] = "Average Fiber"

datasummary(
  (`Average Total Energy`+`Average Total Fat`+`Average Total Carbohydrates` +
     `Average Sodium` + `Average Saturated Fats` + `Average Total Sugars` + 
    `Average Added Sugars` +  `Average Total Cholesterol` + `Average Fiber` 
  )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide,        
  title = "Change in Average Micro and Macro Nutrients Between Endline and Baseline", 
  note = "These measurements were averaged across the ASA24 recalls at endline and baseline, and then the difference was taken (endline - baseline)."
)
Weight Watchers Control
Change in Average Micro and Macro Nutrients Between Endline and Baseline
Timepoint N Mean SD N Mean SD
These measurements were averaged across the ASA24 recalls at endline and baseline, and then the difference was taken (endline - baseline).
Average Total Energy Baseline 187 1945.56 617.46 189 2047.14 725.11
Endline 160 1544.24 552.90 181 1809.61 668.79
Change 160 -424.50 623.76 181 -247.56 653.01
Average Total Fat Baseline 187 84.32 30.79 189 90.53 36.00
Endline 160 64.29 27.41 181 78.88 35.32
Change 160 -21.53 32.46 181 -11.55 35.07
Average Total Carbohydrates Baseline 187 208.13 81.90 189 215.41 85.59
Endline 160 162.49 70.19 181 189.42 80.42
Change 160 -47.02 79.99 181 -28.92 71.47
Average Sodium Baseline 187 3436.90 1130.95 189 3553.56 1393.16
Endline 160 2880.78 1042.01 181 3287.06 1163.17
Change 160 -583.81 1148.46 181 -268.91 1221.80
Average Saturated Fats Baseline 187 27.87 12.00 189 29.40 12.39
Endline 160 20.75 11.00 181 25.29 11.99
Change 160 -7.69 13.36 181 -4.15 13.14
Average Total Sugars Baseline 187 78.52 42.48 189 84.60 42.28
Endline 160 60.64 38.22 181 71.03 42.74
Change 160 -17.62 41.87 181 -14.82 40.62
Average Added Sugars Baseline 187 11.58 8.66 189 12.54 8.24
Endline 160 7.73 7.92 181 10.05 8.25
Change 160 -3.73 8.74 181 -2.69 8.57
Average Total Cholesterol Baseline 187 321.36 169.59 189 341.94 193.44
Endline 160 282.97 187.80 181 315.25 175.82
Change 160 -39.69 194.70 181 -21.96 188.28
Average Fiber Baseline 187 17.43 7.59 189 17.82 8.85
Endline 160 15.70 9.33 181 16.05 7.63
Change 160 -2.12 8.16 181 -1.92 7.63

Weight loss

# Percent body weight change

# Nice labels for table
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "weightkg"] = "Body Weight (kg)"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "weight"] = "Body Weight (lb)"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "BMI"] = "BMI"

datasummary(
  (`Body Weight (kg)` + `Body Weight (lb)` + `BMI`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide,
  title = "Weight Loss Measures"
)
Weight Watchers Control
Weight Loss Measures
Timepoint N Mean SD N Mean SD
Body Weight (kg) Baseline 186 94.56 17.05 189 94.99 16.94
Endline 153 90.26 17.66 177 93.72 17.71
Change 152 -5.49 7.03 177 -1.47 4.76
Body Weight (lb) Baseline 186 208.46 37.59 189 209.42 37.35
Endline 153 198.99 38.94 177 206.62 39.05
Change 152 -12.10 15.49 177 -3.24 10.50
BMI Baseline 186 33.64 4.60 189 33.65 4.78
Endline 153 31.92 5.03 177 33.11 5.08
Change 152 -1.92 2.39 177 -0.51 1.66
# Measures only at endline
outcomes_tab_data_wide_el <- subset(outcomes_tab_data_wide, Timepoint == "Endline")
outcomes_tab_data_wide_el$Timepoint <- as.character(outcomes_tab_data_wide_el$Timepoint)

# Nice labels for table
colnames(outcomes_tab_data_wide_el)[colnames(outcomes_tab_data_wide_el) == "achieve_3_percent_wl"] = "Achieved 3% Weight Loss"
colnames(outcomes_tab_data_wide_el)[colnames(outcomes_tab_data_wide_el) == "achieve_5_percent_wl"] = "Achieved 5% Weight Loss"
colnames(outcomes_tab_data_wide_el)[colnames(outcomes_tab_data_wide_el) == "achieve_10_percent_wl"] = "Achieved 10% Weight Loss"
colnames(outcomes_tab_data_wide_el)[colnames(outcomes_tab_data_wide_el) == "changekg_percent_body_wt"] = "Change in Body Weight (%)"

# make binary 0/1 factors
outcomes_tab_data_wide_el$`Achieved 3% Weight Loss` <- as.character(outcomes_tab_data_wide_el$`Achieved 3% Weight Loss`)
outcomes_tab_data_wide_el$`Achieved 5% Weight Loss` <- as.character(outcomes_tab_data_wide_el$`Achieved 5% Weight Loss`)
outcomes_tab_data_wide_el$`Achieved 10% Weight Loss` <- as.character(outcomes_tab_data_wide_el$`Achieved 10% Weight Loss`)

outcomes_tab_data_wide_el$`Achieved 10% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 10% Weight Loss` == "0"] = "No"
outcomes_tab_data_wide_el$`Achieved 10% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 10% Weight Loss` == "1"] = "Yes"
outcomes_tab_data_wide_el$`Achieved 5% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 5% Weight Loss` == "0"] = "No"
outcomes_tab_data_wide_el$`Achieved 5% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 5% Weight Loss` == "1"] = "Yes"
outcomes_tab_data_wide_el$`Achieved 3% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 3% Weight Loss` == "0"] = "No"
outcomes_tab_data_wide_el$`Achieved 3% Weight Loss`[outcomes_tab_data_wide_el$`Achieved 3% Weight Loss` == "1"] = "Yes"

table1(~ `Change in Body Weight (%)` + `Achieved 3% Weight Loss`+`Achieved 5% Weight Loss` + `Achieved 10% Weight Loss` | Treatment, data = outcomes_tab_data_wide_el, caption = "Captured at Endline Only", overall = FALSE, render.continuous = for.cont.variables)
Captured at Endline Only
Weight Watchers
(N=187)
Control
(N=189)
Change in Body Weight (%)
Mean (SD) -5.63 (6.84) -1.55 (5.08)
Missing 35 (18.7%) 12 (6.3%)
Achieved 3% Weight Loss
No 60 (32.1%) 116 (61.4%)
Yes 92 (49.2%) 61 (32.3%)
Missing 35 (18.7%) 12 (6.3%)
Achieved 5% Weight Loss
No 75 (40.1%) 139 (73.5%)
Yes 77 (41.2%) 38 (20.1%)
Missing 35 (18.7%) 12 (6.3%)
Achieved 10% Weight Loss
No 116 (62.0%) 169 (89.4%)
Yes 36 (19.3%) 8 (4.2%)
Missing 35 (18.7%) 12 (6.3%)

Behavioral

# Change in Physical Activity (Sedentary, Moderate and Vigorous) 
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "sendentary"] = "Sedentary"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "moderate"] = "Moderate"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "vigorous"] = "Vigorous"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "METS"] = "Total Physical Activity MET"

datasummary(
  (`Total Physical Activity MET`+`Sedentary`+`Moderate`+`Vigorous`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide, title = "Change in Physical Activity"
)
Weight Watchers Control
Change in Physical Activity
Timepoint N Mean SD N Mean SD
Total Physical Activity MET Baseline 187 1849.58 2948.47 189 1678.16 2434.54
Endline 152 2368.04 3114.03 175 2265.46 3084.34
Change 152 488.62 2688.09 175 568.94 2794.94
Sedentary Baseline 187 495.21 230.77 189 492.71 228.34
Endline 152 427.97 205.01 175 453.46 227.97
Change 152 -70.68 212.67 175 -32.83 191.69
Moderate Baseline 187 1110.12 1662.07 189 1047.89 1852.37
Endline 152 1335.83 1930.96 175 1262.63 1624.53
Change 152 150.88 1975.05 175 198.79 1912.72
Vigorous Baseline 187 739.47 2095.51 189 630.26 1205.31
Endline 152 1032.21 1905.31 175 1002.83 2093.05
Change 152 337.74 1891.32 175 370.15 1661.99
# Self-reported sleep quality
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "sleep_quality"] = "Sleep Quality"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "sleep_amount"] = "Usual Sleep Amount"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "wake_episodes"] = "Wake Episodes"

datasummary(
  (`Sleep Quality`+`Usual Sleep Amount`+`Wake Episodes`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide, title = "Change in Self-Reported Sleep"
)
Weight Watchers Control
Change in Self-Reported Sleep
Timepoint N Mean SD N Mean SD
Sleep Quality Baseline 187 2.39 0.77 189 2.38 0.73
Endline 160 2.34 0.88 181 2.57 0.84
Change 160 -0.05 0.73 181 0.18 0.79
Usual Sleep Amount Baseline 187 2.03 0.28 189 2.03 0.33
Endline 160 1.99 0.37 181 2.09 0.36
Change 160 -0.05 0.44 181 0.05 0.44
Wake Episodes Baseline 187 1.35 1.12 189 1.32 1.17
Endline 157 1.33 1.30 179 1.26 1.29
Change 157 -0.04 1.26 179 -0.04 1.12

For sleep quality, lower numbers are better where 1 is very good sleep quality and 5 is very poor sleep quality so higher number of change in sleep quality is worse. Recall for sleep amount 1 is more than usual, 2 is usual, and 3 is much less sleep than usual.

# Change in habit strength
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "SRBAI"] = "SRBAI Habit Strength"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg1"] = "Considering Portion Sizes"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg2"] = "Tracking Food Consumption"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg3"] = "Consider WW Points"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg4"] = "Frequency of Eating Vegetables"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg5"] = "Frequency of Weighing Self"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg6"] = "Frequency of Physical Activity"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg7"] = "Talking Kindly to Self After Setback"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg8"] = "Arranging Healthy Foods for Easy Access"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg9"] = "Frequency of Fried Foods"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg10"] = "Frequency of Sweets"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg11"] = "Frequency of Sugary Beverages"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "Avg12"] =  "Snacking When Not Hungry"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "UnhSRBAI"] = "Unhealthy Grouped"
colnames(outcomes_tab_data_wide)[colnames(outcomes_tab_data_wide) == "healSRBAI"] = "Healthy Grouped"

datasummary(
  (`SRBAI Habit Strength` + `Considering Portion Sizes` + `Tracking Food Consumption`+`Consider WW Points`+
     `Frequency of Eating Vegetables`+`Frequency of Weighing Self`+`Frequency of Physical Activity`+
     `Talking Kindly to Self After Setback`+`Arranging Healthy Foods for Easy Access`+`Frequency of Fried Foods`+
     `Frequency of Sweets`+`Frequency of Sugary Beverages`+ `Snacking When Not Hungry`+`Unhealthy Grouped`+`Healthy Grouped`
   )*Timepoint ~ Treatment * (N + Mean + SD),
  data = outcomes_tab_data_wide, title = "Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)"
)
Weight Watchers Control
Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)
Timepoint N Mean SD N Mean SD
SRBAI Habit Strength Baseline 187 3.26 0.89 189 3.32 0.83
Endline 152 4.07 0.82 175 3.60 0.92
Change 152 0.79 0.91 175 0.28 0.81
Considering Portion Sizes Baseline 187 3.75 1.84 189 3.76 1.73
Endline 152 4.89 1.46 175 4.39 1.59
Change 152 1.10 1.90 175 0.67 1.82
Tracking Food Consumption Baseline 187 2.05 1.61 189 1.96 1.67
Endline 152 3.36 1.85 175 2.72 1.90
Change 152 1.27 2.05 175 0.82 1.95
Consider WW Points Baseline 187 0.57 1.32 189 0.71 1.44
Endline 152 3.87 1.98 175 1.46 2.00
Change 152 3.35 2.29 175 0.69 1.70
Frequency of Eating Vegetables Baseline 187 4.80 1.64 189 4.77 1.73
Endline 152 5.34 1.43 175 5.05 1.74
Change 152 0.56 1.70 175 0.30 1.46
Frequency of Weighing Self Baseline 187 3.32 2.03 189 3.26 2.12
Endline 152 4.34 1.89 175 3.75 2.06
Change 152 1.00 1.82 175 0.41 1.87
Frequency of Physical Activity Baseline 187 3.60 1.66 189 3.57 1.84
Endline 152 4.26 1.65 175 3.96 1.79
Change 152 0.69 1.65 175 0.36 1.63
Talking Kindly to Self After Setback Baseline 187 3.04 1.91 189 3.36 1.99
Endline 152 3.72 1.76 175 3.55 1.97
Change 152 0.68 1.74 175 0.19 1.94
Arranging Healthy Foods for Easy Access Baseline 187 3.08 2.21 189 3.21 2.23
Endline 152 4.25 1.94 175 3.58 2.08
Change 152 1.05 2.46 175 0.46 2.13
Frequency of Fried Foods Baseline 187 3.51 1.89 189 3.39 1.87
Endline 152 2.75 1.92 175 3.08 1.93
Change 152 -0.69 1.85 175 -0.27 1.66
Frequency of Sweets Baseline 187 4.57 1.81 189 4.48 1.87
Endline 152 3.23 1.86 175 3.96 1.89
Change 152 -1.28 1.97 175 -0.49 1.95
Frequency of Sugary Beverages Baseline 187 2.43 2.31 189 2.48 2.36
Endline 152 1.46 1.87 175 2.13 2.28
Change 152 -0.76 1.81 175 -0.39 1.89
Snacking When Not Hungry Baseline 187 4.59 1.85 189 4.54 1.86
Endline 152 3.81 1.81 175 4.01 2.04
Change 152 -0.77 1.67 175 -0.48 2.07
Unhealthy Grouped Baseline 187 3.78 1.39 189 3.72 1.36
Endline 152 2.81 1.40 175 3.29 1.37
Change 152 -0.88 1.28 175 -0.41 1.34
Healthy Grouped Baseline 187 3.03 1.02 189 3.07 1.00
Endline 152 4.25 1.00 175 3.56 1.07
Change 152 1.21 1.07 175 0.49 0.97

Missingness

Completeness by Demographics

We explored the completion rate of the study by demographic subgroups.

# completers and non completers by demographics
completers_df <- raw_data %>% 
  dplyr::select(
    WINS.ID, 
    # demographics from model
    Sex_bcf, Age_years, Race2_bcf, Ethnicity_bcf, Education_grouped, BMI_bl, Treatment,
    # additional variables requested by team
    weightkg_bl, HEI2015_TOTAL_SCORE_bl,
    # variables to determine completers
    HEI2015_TOTAL_SCORE_el, weightkg_el
  ) %>%
  dplyr:::mutate(
    ASA24_completers = 
      case_when(is.na(HEI2015_TOTAL_SCORE_el) ~ "No", 
                !is.na(HEI2015_TOTAL_SCORE_el) ~ "Yes"),
    Qualtrics_completers = 
      case_when(is.na(weightkg_el) ~ "No", 
                !is.na(weightkg_el) ~ "Yes")
  )

# Nice labels for table
colnames(completers_df)[colnames(completers_df) == "ASA24_completers"] = "ASA24 Completers"
colnames(completers_df)[colnames(completers_df) == "Qualtrics_completers"] = "Qualtrics Completers"

colnames(completers_df)[colnames(completers_df) == "Sex_bcf"] = "Sex assigned at birth"
colnames(completers_df)[colnames(completers_df) == "Age_years"] = "Age, years"
colnames(completers_df)[colnames(completers_df) == "Race2_bcf"] = "Self-identified race"
colnames(completers_df)[colnames(completers_df) == "Ethnicity_bcf"] = "Self-identified as Hispanic, Latinx, Latine, or Spanish"
colnames(completers_df)[colnames(completers_df) == "Education_grouped"] = "Highest level of education achieved"
colnames(completers_df)[colnames(completers_df) == "BMI_bl"] = "BMI at baseline"
colnames(completers_df)[colnames(completers_df) == "weightkg_bl"] = "Body weight at baseline (kg)"
colnames(completers_df)[colnames(completers_df) == "HEI2015_TOTAL_SCORE_bl"] = "HEI-2015 total score at baseline"


ASA24_col <- completers_df %>% dplyr::select(`Sex assigned at birth`,
                                      `Age, years`,
                                      `Self-identified race`,
                                      `Self-identified as Hispanic, Latinx, Latine, or Spanish`,
                                      `Highest level of education achieved`,
                                      `BMI at baseline`,
                                      `Treatment`,
                                      `Body weight at baseline (kg)`,
                                      `HEI-2015 total score at baseline`,
                                      `ASA24 Completers`) %>% 
  tbl_summary(by = `ASA24 Completers`,
              statistic = list(all_continuous() ~ "{mean} [{sd}]", 
                               all_categorical() ~ "{n} ({p}%)"), 
              percent = "row") 

Qualtrics_col <- completers_df %>% dplyr::select(`Sex assigned at birth`,
                                          `Age, years`,
                                          `Self-identified race`,
                                          `Self-identified as Hispanic, Latinx, Latine, or Spanish`,
                                          `Highest level of education achieved`,
                                          `BMI at baseline`,
                                          `Treatment`,
                                          `Body weight at baseline (kg)`,
                                          `HEI-2015 total score at baseline`,
                                          `Qualtrics Completers`) %>% 
  tbl_summary(by = `Qualtrics Completers`,
              statistic = list(all_continuous() ~ "{mean} [{sd}]", 
                               all_categorical() ~ "{n} ({p}%)"), 
              percent = "row")

tbl_merge(
    list(ASA24_col, Qualtrics_col),
    tab_spanner = c("**ASA-24 Completers**", "**Qualtrics Completers**")
  )
Characteristic
ASA-24 Completers
Qualtrics Completers
No
N = 35
1
Yes
N = 341
1
No
N = 46
1
Yes
N = 330
1
Sex assigned at birth



    Female 30 (10%) 268 (90%) 42 (14%) 256 (86%)
    Male 5 (6.4%) 73 (94%) 4 (5.1%) 74 (95%)
Age, years 44 [13] 48 [12] 43 [13] 48 [12]
Self-identified race



    Asian 6 (21%) 22 (79%) 7 (25%) 21 (75%)
    Black or African-American 4 (7.7%) 48 (92%) 7 (13%) 45 (87%)
    Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say 2 (8.3%) 22 (92%) 3 (13%) 21 (88%)
    White 23 (8.5%) 249 (92%) 29 (11%) 243 (89%)
Self-identified as Hispanic, Latinx, Latine, or Spanish 1 (2.8%) 35 (97%) 2 (5.6%) 34 (94%)
Highest level of education achieved



    <=Associates 12 (10%) 104 (90%) 13 (11%) 103 (89%)
    >=Masters 8 (6.3%) 119 (94%) 11 (8.7%) 116 (91%)
    Bach/Some Grad 15 (11%) 118 (89%) 22 (17%) 111 (83%)
BMI at baseline 33.4 [4.5] 33.7 [4.7] 33.4 [4.3] 33.7 [4.7]
    Unknown 0 1 0 1
Treatment



    Weight Watchers 27 (14%) 160 (86%) 34 (18%) 153 (82%)
    Control 8 (4.2%) 181 (96%) 12 (6.3%) 177 (94%)
Body weight at baseline (kg) 91 [15] 95 [17] 91 [12] 95 [17]
    Unknown 0 1 0 1
HEI-2015 total score at baseline 55 [11] 55 [12] 54 [11] 56 [13]
1 n (%); Mean [SD]

ASA24 completion is determined by the HEI Total Score at endline variable and Qualtrics completion is determined by the body weight (kg) variable at endline.

Main Models

Our primary analysis is ANCOVA on change-scores from baseline to 6-months, using Multiply Imputed (MI) data to include all participants randomized (ITT) even where lost to follow-up. Covariates are described below.

Primary Analysis

Imputation

Prior to analysis, all outcomes were grouped in 6 batches of similar type to run multiple imputation (MI) on separately, stratified by treatment (Austin 2021). All outcome variables (change scores) in each batch and their respective baseline measures were included in each imputation data set as well as model covariates (e.g. demographics). Additional auxiliary variables were considered to help inform the missing data imputations in each batch (Allison 2009). Candidate auxiliary variables included all baseline, endline, and outcomes (e.g. change scores) across the full dataset as well as a few additional “proxy” variables (e.g. income). Auxiliary variables were included in an imputation data set when two conditions were met: (1) their correlation with the outcomes in that imputation data set were at least |cor| > 0.4 and (2) including those auxiliary variables provided additional observations where the outcomes of interest contained missing values (Allison 2009, Hardt et al 2012, Madley-Dowd et al, 2023). For example, if change scores were missing due to drop out on an outcome variable of interest but baseline data on another variable with complete data were correlated >0.4 (e.g. HEI total score and ADD_SUGARS_ave_bl), this will add precision to the imputation.

The 6 imputation batches/runs and the variables they included are listed below:

  1. Dietary Quality Group 1:

    • 16 Outcomes: Change in ASA24 HEI diet quality scores (total and subscores), Diet ID total score, as well as aMED score.

    • Covariates: baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

    • Auxiliary variables: ADD_SUGARS_ave_bl

  2. Dietary Quality Group 2:

    • 9 Outcomes: Change in ASA24 average micro and macro nutrients

    • Covariates: baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

    • Auxiliary variables: HEI2015C13_ADDSUG_bl

  3. Weight Loss:

    • 6 Outcomes: Change in body weight (kg), BMI, percent body weight, as well as three percent body weight achievement outcomes.

    • Covariates: baseline weight (kg), participant’s biological sex at birth, age, race/ethnicity, and education.

    • Auxiliary variables: Weightlbs_dietid_change, BMI_dietid_change, BMI_el

  4. Behavioral Group 1:

    • 4 Outcomes: Change in physical activity.

    • Covariates: baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

  5. Behavioral Group 2:

    • 3 Outcomes: Change in self-reported sleep.

    • Covariates: baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

  6. Behavioral Group 3:

    • 15 Outcomes: Change in habit strength (for each behavior assessed, then grouped healthy and unhealthy).

    • Covariates: baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

Multiple imputation was performed in R using the mice package (van Buuren and Groothuis-Oudshoorn 2011) where the number of imputations was determined according to the howManyImputations package (von Hippel 2020). Imputations were run with the mice() function with 10 iterations each, using the predictive mean matching (PMM) method.

The line of R code that implements the imputation is:

imputed <- mice(data.imputation, maxit = 10, m = max.runs, predictorMatrix = predM, method = "pmm", print = TRUE)

where max.runs is the largest number of iterations recommended across all the outcomes of interest in that imputation run.

Statistical Modeling

For primary outcome of HEI-2015 score:

  • Analysis of covariance (ANCOVA) will be used to test baseline to 6-month changes in HEI-2015 total scores for Diet Quality between the WW group and control. Covariates will be included for baseline HEI-2015 total score, participant’s biological sex at birth, age, race/ethnicity, and education.

For secondary outcomes:

  • For percent weight loss, ANCOVA will be used to test the WW group vs control. Covariates will be included for participant’s biological sex at birth, age, race/ethnicity, education, and baseline weight.

  • Achievement of 3/5/10 % weight loss is only observed at the 6-month follow-up and is a binary variable. Logistic regression will be used, and covariates will be included for participant’s biological sex at birth, age, race/ethnicity, education, and baseline weight.

  • The remaining secondary outcomes are measured at baseline and the 6-month post-intervention as continuous scores. ANCOVA will be used to test the baseline to 6-month changes in scores between WW and control groups. Covariates will be included for baseline outcome measures, participant’s biological sex at birth, age, race/ethnicity, and education.

\[ Outcome = Baseline + Sex + Age + Race + Ethnicity + Education + Treatment \]

After analyses were performed for each of the 52 outcomes across 6 imputed data sets, results were pooled across all imputations according to Rubin’s rules using the pool() function provided in the mice package in R.

Cohen’s d unadjusted and adjusted effect sizes are also calculated. Cohen’s d “unadjusted” is a standard measure of d = (Mean 1 - Mean 2) / (pooled SD) \(= \text{(Mean 1 - Mean 2)} / \sqrt{\frac{ ( \text{n}_1 - 1) s_1^2 \ + \ ( \text{n}_2 - 1) s_2^2 }{ \text{n}_1 + \text{n}_2 -2 }}\), where here the mean and SD are calculated on the outcome of interest for each treatment group, and the d values are averaged across all imputations. Cohen’s d “adjusted” is based on the model output adjusted for covariates, and is calculated using the eff_size function in the R package emmeans (Lenth 2023).

Note: Change scores are calculated as endline minus baseline measurements.

# declare baseline/reference levels for imputed data sets
imputed_long_1 <- imputed_references(imputed_long_1)
imputed_long_2 <- imputed_references(imputed_long_2)
imputed_long_3 <- imputed_references(imputed_long_3)
imputed_long_4 <- imputed_references(imputed_long_4)
imputed_long_5 <- imputed_references(imputed_long_5)
imputed_long_6 <- imputed_references(imputed_long_6)


# make output shell table to save results for each outcome in the analysis loop
cols <- c("Outcome", "Outcome_label", "Mean1", "SE1", "Mean2", "SE2", "Mean_Diff", 
          "Mean_Diff_LB", "Mean_Diff_UB",
          "SE_Diff", "Estimate", "SE", "t", "df", "p_value", "Mean_Skewness", "Min_Skewness", 
          "Max_Skewness", "Mean_Kurtosis","Min_Kurtosis",  "Max_Kurtosis", "Levene_Pvalue", 
          "Min_Levene","Max_Levene", "Variance_Residual_Ratio", "Variance_Residual_Ratio_Min", 
          "Variance_Residual_Ratio_Max", "Variance_Outcome_Ratio", "Variance_Outcome_Ratio_Min",
          "Variance_Outcome_Ratio_max", "Number of Participants", "Cohens_d_unadjusted", "Cohens_d_adjusted")
output = matrix(nrow = length(outcomes), ncol = length(cols))
colnames(output) = cols

# In order to save OR CI, let's separate ancova and logistic model output:
cols <- c("Outcome", "Outcome_label", "Mean1", "SE1", "Mean2", "SE2", "Mean_Diff",
          "Mean_Diff_LB", "Mean_Diff_UB",
          "SE_Diff", "Estimate", "SE", "t", "df", "p_value", "Mean_Skewness", "Min_Skewness", 
          "Max_Skewness", "Mean_Kurtosis","Min_Kurtosis",  "Max_Kurtosis", "Levene_Pvalue", 
          "Min_Levene","Max_Levene", "Variance_Residual_Ratio", "Variance_Residual_Ratio_Min", 
          "Variance_Residual_Ratio_Max", "Variance_Outcome_Ratio", "Variance_Outcome_Ratio_Min",
          "Variance_Outcome_Ratio_max", "Number of Participants", "Cohens_d_unadjusted", "Cohens_d_adjusted")
output.ancova = matrix(nrow = length(outcomes)-3, ncol = length(cols))
colnames(output.ancova) = cols
ancova.outcome_pairs = subset(outcome_pairs, outcomes %in% setdiff(outcome_pairs$outcomes,  c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")))

logistic_cols <- c("Outcome", "Outcome_label", "Prob1", "SE1", "Prob2", "SE2", "OR",
                   "OR_LCL", "OR_UCL", "OR_SE",
                   "Estimate", "SE", "z", "df", "p_value", "Mean_Skewness", "Min_Skewness", 
                   "Max_Skewness", "Mean_Kurtosis","Min_Kurtosis",  "Max_Kurtosis", "Levene_Pvalue", 
                   "Min_Levene","Max_Levene", "Variance_Residual_Ratio", "Variance_Residual_Ratio_Min", 
                   "Variance_Residual_Ratio_Max", "Variance_Outcome_Ratio", "Variance_Outcome_Ratio_Min",
                   "Variance_Outcome_Ratio_max", "Number of Participants", "Cohens_d_unadjusted", "Cohens_d_adjusted")
output.logistic = matrix(nrow = 3, ncol = length(logistic_cols))
colnames(output.logistic) =  logistic_cols
logistic.outcome_pairs = subset(outcome_pairs, outcomes %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl"))
# originally this was done to save OR CI for the logistic and not ANCOVAs
# but reviewers later asked for Mean diff CIs as well, so could have just done 
# one output with same number of columns.

##############
## Modeling ##
##############

# models
# "achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl", "weight_change"
# get weight_bl as baseline measurement

# Primary will be ITT with multiple imputation
# Formulas could be printed for verification purposes, but it's long.

# save all residuals:
residual_list_dietqual1 <- data.frame()
residual_list_dietqual2 <- data.frame()
residual_list_weightloss <- data.frame()
residual_list_behavioral1 <- data.frame()
residual_list_behavioral2 <- data.frame()
residual_list_behavioral3 <- data.frame()
# ^ used for sensitivity

for (out in outcomes){
  
  # establish which of the imputed data sets contains the outcome of interest:
  if(out %in% colnames(imputed_long_1)){
    imputed.analysis.data = imputed_long_1
  } else if(out %in% colnames(imputed_long_2)){
    imputed.analysis.data = imputed_long_2
  } else if(out %in% colnames(imputed_long_3)){
    imputed.analysis.data = imputed_long_3
  } else if(out %in% colnames(imputed_long_4)){
    imputed.analysis.data = imputed_long_4
  } else if(out %in% colnames(imputed_long_5)){
    imputed.analysis.data = imputed_long_5
  } else if(out %in% colnames(imputed_long_6)){
    imputed.analysis.data = imputed_long_6
  } 
  
  # setup model formula:
  if (out %in%  c("changekg_percent_body_wt", "achieve_3_percent_wl", "achieve_5_percent_wl", 
                  "achieve_10_percent_wl" # weight loss
  )){ # these outcomes dont match the _change, _bl structure
    formula = paste0(" ~ weightkg_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment")
  } else{formula = paste0("~ ", gsub("_change", "_bl", out), # everything else
                          " + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment")} 
  
  # setup model:
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic for binary outcomes
    primary.model <- plyr::dlply(imputed.analysis.data, ".imp", function(df)
      glm(as.formula(paste(out, formula)), data = df, family = "binomial"))
    
  } else{
    # ANCOVA for continuous outcomes
    primary.model <- plyr::dlply(imputed.analysis.data, ".imp", function(df)
      lm(as.formula(paste(out, formula)), data = df))
    
  }
  
  # Difference between groups:
  emm.model <- as.mira(primary.model)
  # this command is used so that the emmeans packages recognizes that emm.model is a list of imputed models.
  # this is necessary so that the results are pooled using rubin's rules (https://github.com/rvlenth/emmeans/issues/80)
  
  # emmeans is different for logistic vs lm: 
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic
    emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
    
    # to get OR CI:
    emm.pairs.CI = confint( pairs(emmeans(emm.model, "Treatment", type = "response")))
    
  } else{
    # ANCOVA
    emm <- emmeans::emmeans(emm.model, "Treatment") # estimate, SE, df, z, p
    
    # pairs or pairwise
    emm.pairs = pairs(emmeans(emm.model, "Treatment")) # T1 - T2 estiamte SD df z p
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
    
    # to get OR CI:
    emm.pairs.CI = confint( pairs(emmeans(emm.model, "Treatment")))
  }
  
  
  ## Diagnostics:
  ####################
  skewness.mean <- mean(moments::skewness(sapply(primary.model, rstandard)))
  # calculate skewness
  skewness.max <- max( abs( moments::skewness(sapply(primary.model, rstandard)) ) ) 
  skewness.min <- min(moments::skewness(sapply(primary.model, rstandard)))
  
  # save the residuals from the imputed models back onto the data set
  # by adding a new column for the standardized residuals from each model
  imputed.data.resids <- cbind(imputed.analysis.data,
                               data.frame(residuals = unlist(llply(primary.model, rstandard), use.names = FALSE)))
  # factor treatment to group by later
  imputed.data.resids$Treatment = factor(imputed.data.resids$Treatment)

  # have to save as several data frames because too large for one
  if(out %in% colnames(imputed_long_1)){
    residual_list_dietqual1 <- rbind(residual_list_dietqual1, 
                                     cbind(imputed.data.resids, 
                                           outcome = out)) 
  }
  if(out %in% colnames(imputed_long_2)){
    residual_list_dietqual2 <- rbind(residual_list_dietqual2, 
                                     cbind(imputed.data.resids, 
                                           outcome = out)) 
  }
  if(out %in% colnames(imputed_long_3)){
    residual_list_weightloss <- rbind(residual_list_weightloss, 
                                      cbind(imputed.data.resids, 
                                            outcome = out)) 
  }
  if(out %in% colnames(imputed_long_4)){
    residual_list_behavioral1 <- rbind(residual_list_behavioral1, 
                                       cbind(imputed.data.resids, 
                                             outcome = out)) 
  }
  if(out %in% colnames(imputed_long_5)){
    residual_list_behavioral2 <- rbind(residual_list_behavioral2, 
                                       cbind(imputed.data.resids, 
                                             outcome = out)) 
  }
  if(out %in% colnames(imputed_long_6)){
    residual_list_behavioral3 <- rbind(residual_list_behavioral3, 
                                       cbind(imputed.data.resids, 
                                             outcome = out)) 
  }
  
  # run the levene's test on each dataset individually, then extract just the p-value
  levene <- dlply(imputed.data.resids, ".imp", function(df)
    car::leveneTest(residuals ~ Treatment, data = df)$`Pr(>F)`[1])
  # mean, min, max
  levene.pval <- mean(unlist(levene))
  levene.min <- min(unlist(levene))
  levene.max <- max(unlist(levene))
  
  # calculate the ratio of residual variance
  # first calculate the variance of residuals by group, by imputation.
  imputed.data.resids <- imputed.data.resids %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(variance.resids = var(residuals), .groups = "keep")
  # then group by just imputation to compare the two variances
  imputed.data.resids <- imputed.data.resids %>%
    group_by(.imp) %>% 
    dplyr::summarise(ratio.var.resid = 
                       variance.resids[Treatment == rownames(table(imputed.analysis.data$Treatment))[1]]/
                       variance.resids[Treatment == rownames(table(imputed.analysis.data$Treatment))[2]])
  # mean, min, max
  variance.residual.ratio.mean <- mean(imputed.data.resids$ratio.var.resid)
  variance.residual.ratio.min <- min(imputed.data.resids$ratio.var.resid)
  variance.residual.ratio.max <- max(imputed.data.resids$ratio.var.resid)
  # and above to take the mean across all imputation sets
  
  # calculate kurtosis mean, max, min
  kurtosis.mean <- mean(moments::kurtosis(sapply(primary.model, rstandard)))
  kurtosis.max <- max(moments::kurtosis(sapply(primary.model, rstandard)))
  kurtosis.min <- min(moments::kurtosis(sapply(primary.model, rstandard)))
  
  # calculate the ratio of outcome variance
  # first calculate the variance of outcome by group, by imputation
  variance.outcome.ratios <- imputed.analysis.data %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(variance.outcome = var(.data[[out]]), .groups = "keep")
  # then group by just imputation to compare the two variances
  variance.outcome.ratios <- variance.outcome.ratios %>% group_by(.imp) %>% 
    dplyr::summarise(variance.outcome.ratio = 
                       variance.outcome[Treatment == rownames(table(imputed.analysis.data$Treatment))[1]]/
                       variance.outcome[Treatment == rownames(table(imputed.analysis.data$Treatment))[2]])
  # mean, min, max
  variance.outcome.ratio.mean <- mean(variance.outcome.ratios$variance.outcome.ratio)
  variance.outcome.ratio.min <- min(variance.outcome.ratios$variance.outcome.ratio)
  variance.outcome.ratio.max <- max(variance.outcome.ratios$variance.outcome.ratio)
  
  
  # Report measure of effect size, Cohen's d 
  # on imputed for each imputed data set, then average across for all outcomes
  
  # Cohen’s d is calculated from means and SD for differences between groups, 
  # where d=(Mean1-Mean2)/pooled_SD
  
  # Calculate effect size components by imputation and treatment (for non-binary):
  # first calculate components by imputation and treatment
  effect_size <- imputed.analysis.data %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(Mean = mean(.data[[out]]),
                     SD = stats:::sd(.data[[out]]),
                     n = length(.data[[out]]),
                     .groups = "keep")
  
  # then calculate effect size by imputation (no longer grouping by treatment)
  effect_size2 <- effect_size %>% group_by(.imp) %>%
    dplyr::summarise(cohensd = (Mean[Treatment == 1] - Mean[Treatment == 2]) / 
                       sqrt( ((n[Treatment == 1] - 1) * SD[Treatment == 1]^2 +
                                (n[Treatment == 2] - 1) * SD[Treatment == 2]^2) / 
                               (n[Treatment == 1] + n[Treatment == 2] - 2)
                       ),
                     .groups = "keep")
  
  
  # Calculate cohens d from model, adjusting for covariates:
  effect_size2$cohensd2 <- NA
  # emmeans is different for logistic vs lm: 
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    
    # for logistic the effect size is the odds ratio
    
    # logistic
    # emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    # emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
    
    effect_size2$cohensd2  = data.frame(emm.pairs)$odds.ratio
    
  } else{
    
    for (iter in 1:max(imputed.analysis.data$.imp)){
      # ANCOVA
      emm_iter <- emmeans::emmeans(primary.model[[iter]], "Treatment") # estimate, SE, df, z, p
      
      # pairs or pairwise
      emm.pairs_iter = pairs(emmeans(primary.model[[iter]], "Treatment")) # T1 - T2 estiamte SD df z p
      
      contrast = data.frame(emm.pairs_iter)
      effect_size2[iter, "cohensd2"] <- data.frame(eff_size(emm_iter, 
                                                            sigma = sigma(primary.model[[iter]]), 
                                                            edf = contrast[, "df"]))$effect.size
    }
  }
  
  n_participants <- length(rstandard(primary.model[[1]]))
  
  
  # Save differently for different models:
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic
    #emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    #emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    
    output[which(outcomes == out),] =
      c(out, outcome_pairs$outcome_labels[which(outcome_pairs$outcomes == out)],
        summary(emm)$prob[1], summary(emm)$SE[1], # prob and SE X
        summary(emm)$prob[2], summary(emm)$SE[2], # prob and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$odds.ratio, emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
    
    output.logistic[which(logistic.outcome_pairs$outcomes == out),] =
      c(out, logistic.outcome_pairs$outcome_labels[which(logistic.outcome_pairs$outcomes == out)],
        summary(emm)$prob[1], summary(emm)$SE[1], # prob and SE X
        summary(emm)$prob[2], summary(emm)$SE[2], # prob and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$odds.ratio, emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
      
  } else{
    # ANCOVA
    #emm <- emmeans::emmeans(emm.model, "Treatment") # estimate, SE, df, z, p
    
    # pairs or pairwise
    #emm.pairs = pairs(emmeans(emm.model, "Treatment")) # T1 - T2 estiamte SD df z p
    
    output[which(outcomes == out),] =
      c(out, outcome_pairs$outcome_labels[which(outcome_pairs$outcomes == out)],
        summary(emm)$emmean[1], summary(emm)$SE[1], # mean and SE X
        summary(emm)$emmean[2], summary(emm)$SE[2], # mean and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$estimate,  emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
    output.ancova[which(ancova.outcome_pairs$outcomes == out),] =
      c(out, ancova.outcome_pairs$outcome_labels[which(ancova.outcome_pairs$outcomes == out)],
        summary(emm)$emmean[1], summary(emm)$SE[1], # mean and SE X
        summary(emm)$emmean[2], summary(emm)$SE[2], # mean and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$estimate,  emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
    
  }
  
  # Optionl returns while loop running:
  #print(paste(out, formula))
  print(paste0(out, " outcome ", which(outcomes == out), " of ", length(outcomes),"."))
}

# Combined model results
output = as.data.frame(output)
output.ancova = as.data.frame(output.ancova)
output.logistic = as.data.frame(output.logistic)


# Save residuals and output table:
save(residual_list_dietqual1, residual_list_dietqual2,
     residual_list_weightloss, 
     residual_list_behavioral1, residual_list_behavioral2, residual_list_behavioral3, 
     output,output.ancova, output.logistic,
     file = paste0("WINS_Main_Analysis_primary_", Sys.Date(), ".RData"))
# load in results from chunk above:
load("WINS_Main_Analysis_primary_2025-01-28.RData")


output = as.data.frame(output)
output.logistic = as.data.frame(output.logistic)
output.ancova = as.data.frame(output.ancova)

# save for wilcox comparison
primary_results <- output
output.ancova.raw <- output.ancova
output.logistic.raw <- output.logistic

# Format columns:
output.ancova[,3:ncol(output.ancova)] = apply(output.ancova[,3:ncol(output.ancova)], 2, as.numeric)

output.logistic[,3:ncol(output.logistic)] = apply(output.logistic[,3:ncol(output.logistic)], 2, as.numeric)


# format p-values:
output.ancova <- output.ancova %>% 
  mutate(
    p_value = case_when(.data[["p_value"]] < 0.001 ~ sub(" ", "", format.pval(.data[["p_value"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["p_value"]], digits = 3, format = "f")),
    Levene_Pvalue = case_when(.data[["Levene_Pvalue"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Levene_Pvalue"]], eps = 0.001, digits = 3, nsmall=3)),
                              TRUE ~ formatC(.data[["Levene_Pvalue"]], digits = 3, format = "f")),
    Min_Levene = case_when(.data[["Min_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Min_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Min_Levene"]], digits = 3, format = "f")),
    Max_Levene = case_when(.data[["Max_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Max_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Max_Levene"]], digits = 3, format = "f"))
    
  )
output.logistic <- output.logistic %>% 
  mutate(
    p_value = case_when(.data[["p_value"]] < 0.001 ~ sub(" ", "", format.pval(.data[["p_value"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["p_value"]], digits = 3, format = "f")),
    Levene_Pvalue = case_when(.data[["Levene_Pvalue"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Levene_Pvalue"]], eps = 0.001, digits = 3, nsmall=3)),
                              TRUE ~ formatC(.data[["Levene_Pvalue"]], digits = 3, format = "f")),
    Min_Levene = case_when(.data[["Min_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Min_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Min_Levene"]], digits = 3, format = "f")),
    Max_Levene = case_when(.data[["Max_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Max_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Max_Levene"]], digits = 3, format = "f"))
    
  )

# round non-pvalues to 2 decimal places
p_values = which(colnames(output.ancova) %in% c("p_value", "Levene_Pvalue",
                             "Min_Levene", "Max_Levene"))
non_pvals <- setdiff(3:ncol(output.ancova), p_values)
output.ancova[,non_pvals] = apply(output.ancova[,non_pvals], 2, function(x) sprintf("%.2f", x))
  #round(output.ancova[,non_pvals], digits = 2)

# binary outcomes:
p_values = which(colnames(output.logistic) %in% c("p_value", "Levene_Pvalue",
                                      "Min_Levene", "Max_Levene"))
non_pvals <- setdiff(3:ncol(output.logistic), p_values)
output.logistic[,non_pvals] = apply(output.logistic[,non_pvals], 2, function(x) sprintf("%.2f", x))

rownames(output.ancova) = NULL
rownames(output.logistic) = NULL

# to keep outcome pairs indices, combine CI:
temp = outcome_pairs %>% dplyr::rename(Outcome = outcomes) %>% 
  dplyr::rename(Outcome_label = outcome_labels)

output.ancova <- merge(temp, output.ancova, by = c("Outcome", "Outcome_label"), sort = FALSE) #all = TRUE,
output.ancova <- output.ancova %>% mutate(
  Mean_Diff_CI = paste0("(", Mean_Diff_LB, ", ", Mean_Diff_UB, ")")
)  %>%
  select(-Mean_Diff_LB, -Mean_Diff_UB) %>%
  select(
    Outcome, Outcome_label, Mean1, SE1, Mean2, SE2, Mean_Diff, 
    Mean_Diff_CI, SE_Diff, Estimate, SE, t, df, p_value, 
    Mean_Skewness, Min_Skewness, Max_Skewness, Mean_Kurtosis, Min_Kurtosis, 
    Max_Kurtosis, Levene_Pvalue, Min_Levene, Max_Levene, 
    Variance_Residual_Ratio, Variance_Residual_Ratio_Min, 
    Variance_Residual_Ratio_Max, Variance_Outcome_Ratio, 
    Variance_Outcome_Ratio_Min, Variance_Outcome_Ratio_max, 
    `Number of Participants`, Cohens_d_unadjusted, Cohens_d_adjusted
  )

Dietary quality

kable(output.ancova[1:14,-c(10, 11, 15:(ncol(output.ancova)-2))],
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"),
      caption = "Change in ASA24 HEI Diet Quality Scores (Total and Subscores)") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in ASA24 HEI Diet Quality Scores (Total and Subscores)
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
HEI2015_TOTAL_SCORE_change HEI Total Score 5.31 1.51 1.13 1.37 4.18 (1.80, 6.56) 1.21 -3.45 332.56 <0.001 0.30 0.37
HEI2015C1_TOTALVEG_change Total Vegetable 0.18 0.17 0.06 0.15 0.12 (-0.14, 0.38) 0.13 -0.91 291.44 0.365 0.08 0.10
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 0.89 0.28 0.18 0.25 0.71 (0.27, 1.15) 0.22 -3.19 293.87 0.002 0.21 0.35
HEI2015C3_TOTALFRUIT_change Total Fruit 0.49 0.24 -0.05 0.21 0.53 (0.15, 0.91) 0.19 -2.77 290.72 0.006 0.27 0.31
HEI2015C4_WHOLEFRUIT_change Whole Fruit 0.12 0.26 -0.38 0.23 0.50 (0.09, 0.92) 0.21 -2.38 308.93 0.018 0.22 0.26
HEI2015C5_WHOLEGRAIN_change Whole Grains 1.05 0.43 0.58 0.40 0.47 (-0.22, 1.16) 0.35 -1.34 315.42 0.183 0.07 0.15
HEI2015C6_TOTALDAIRY_change Total Dairy -0.52 0.39 -0.24 0.35 -0.28 (-0.89, 0.34) 0.31 0.88 296.63 0.381 -0.02 -0.10
HEI2015C7_TOTPROT_change Total Protein Foods 0.07 0.09 0.05 0.08 0.02 (-0.12, 0.16) 0.07 -0.33 288.86 0.738 0.05 0.04
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 0.24 0.27 0.10 0.24 0.14 (-0.28, 0.57) 0.22 -0.66 315.34 0.510 -0.01 0.07
HEI2015C9_FATTYACID_change Fatty Acids 1.21 0.46 0.95 0.40 0.27 (-0.44, 0.97) 0.36 -0.74 282.71 0.460 0.08 0.08
HEI2015C10_SODIUM_change Sodium -1.08 0.36 -0.84 0.33 -0.25 (-0.82, 0.33) 0.29 0.84 311.17 0.400 -0.01 -0.09
HEI2015C11_REFINEDGRAIN_change Refined Grains 0.55 0.44 -0.59 0.39 1.14 (0.44, 1.84) 0.36 -3.19 279.74 0.002 0.33 0.36
HEI2015C12_SFAT_change Saturated Fats 1.51 0.45 0.89 0.40 0.62 (-0.08, 1.32) 0.36 -1.74 305.85 0.083 0.14 0.19
HEI2015C13_ADDSUG_change Added Sugars 0.60 0.28 0.44 0.25 0.16 (-0.28, 0.60) 0.22 -0.72 304.15 0.470 0.02 0.08
temp <- output.ancova[15,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), 
      caption = "Other Dietary Quality Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Other Dietary Quality Measures
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
amed_change AMED Score 0.86 0.65 0.18 0.59 0.68 (-0.35, 1.70) 0.52 -1.30 323.36 0.196 0.10 0.14
temp <- output.ancova[16:24,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), 
      caption = "Change in Average Micro and Macro Nutrients Between Endline and Baseline") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Average Micro and Macro Nutrients Between Endline and Baseline
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
KCAL_ave_change Average Total Energy -468.22 70.01 -241.77 63.84 -226.44 (-336.93, -115.96) 56.17 4.03 336.57 <0.001 -0.28 -0.43
TFAT_ave_change Average Total Fat -22.27 3.75 -9.88 3.38 -12.39 (-18.30, -6.48) 3.01 4.12 329.62 <0.001 -0.27 -0.45
CARB_ave_change Average Total Carbohydrates -50.49 8.50 -26.79 7.72 -23.70 (-37.17, -10.23) 6.85 3.46 315.60 <0.001 -0.27 -0.38
SODI_ave_change Average Sodium -549.96 128.91 -180.12 116.19 -369.84 (-573.75, -165.92) 103.63 3.57 310.54 <0.001 -0.27 -0.39
SFAT_ave_change Average Saturated Fats -8.39 1.42 -4.17 1.28 -4.22 (-6.46, -1.98) 1.14 3.71 334.20 <0.001 -0.25 -0.40
SUGR_ave_change Average Total Sugars -25.26 4.69 -17.78 4.26 -7.49 (-14.87, -0.10) 3.75 1.99 335.41 0.047 -0.10 -0.21
ADD_SUGARS_ave_change Average Added Sugars -5.01 0.97 -3.18 0.87 -1.84 (-3.37, -0.30) 0.78 2.36 318.86 0.019 -0.15 -0.26
CHOLE_ave_change Average Total Cholesterol -48.79 22.80 -23.50 20.25 -25.29 (-61.20, 10.63) 18.25 1.39 287.58 0.167 -0.07 -0.15
FIBE_ave_change Average Fiber -1.86 0.97 -1.48 0.86 -0.38 (-1.90, 1.13) 0.77 0.50 282.98 0.619 -0.03 -0.06

These measurements were averaged across the ASA24 recalls at endline and baseline, and then the difference was taken (endline - baseline).

Weight loss

temp <- output.ancova[25:27,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Weight Loss Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Weight Loss Measures
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
weightkg_change Body Weight (kg) -5.43 0.91 -1.55 0.79 -3.88 (-5.29, -2.47) 0.71 5.43 266.69 <0.001 -0.61 -0.61
BMI_change BMI -1.89 0.32 -0.55 0.27 -1.34 (-1.83, -0.85) 0.25 5.37 259.18 <0.001 -0.61 -0.61
changekg_percent_body_wt Percent Body Weight Change -5.44 0.92 -1.53 0.80 -3.91 (-5.35, -2.48) 0.73 5.37 257.98 <0.001 -0.61 -0.61
temp <- output.logistic[,-c(11, 12, 16:ncol(output.logistic) )]
# combine CIs
temp$CI = paste0("(", formatC(temp$OR_LCL, digits = 2, format = "f"), ", ", formatC(temp$OR_UCL, digits = 2, format = "f"), ")")
temp <- temp[,-which(colnames(temp) %in% c("OR_LCL", "OR_UCL"))]
rownames(temp) = NULL
kable(temp[,c(1:7, 12, 8:11)],
      col.names = c("Variable", "Outcome", "Probability", "SE", "Probability", "SE", "OR", "OR CI", "SE", "z", "df", "p-value"), caption = "Logisitc Weight Loss Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Odds Ratio" = 3, "Model Statistics" = 3))
Logisitc Weight Loss Measures
Weight Watchers
Control
Odds Ratio
Model Statistics
Variable Outcome Probability SE Probability SE OR OR CI SE z df p-value
achieve_3_percent_wl Achieved 3% Weight Loss 0.59 0.07 0.35 0.06 2.68 (1.70, 4.25) 0.63 -4.21 277.66 <0.001
achieve_5_percent_wl Achieved 5% Weight Loss 0.47 0.08 0.21 0.05 3.34 (2.07, 5.38) 0.81 -4.96 299.75 <0.001
achieve_10_percent_wl Achieved 10% Weight Loss 0.19 0.08 0.03 0.02 7.10 (3.18, 15.84) 2.91 -4.79 272.74 <0.001

The effect size from the model, adjusted for covariates, would be the odds ratio of the difference for binary outcomes.

Behavioral

temp <- output.ancova[28:31,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Physical Activity") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Physical Activity
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
METS_change Total Physical Activity MET 672.30 337.62 750.93 306.59 -78.63 (-600.91, 443.66) 265.53 0.30 342.70 0.767 -0.05 -0.03
sendentary_change Sedentary -70.17 26.23 -37.28 23.31 -32.89 (-74.15, 8.37) 20.95 1.57 234.59 0.118 -0.15 -0.18
moderate_change Moderate 231.95 211.27 293.29 191.95 -61.34 (-391.88, 269.20) 168.03 0.37 330.16 0.715 -0.04 -0.04
vigorous_change Vigorous 511.77 227.53 515.64 205.43 -3.87 (-359.30, 351.56) 180.69 0.02 332.74 0.983 -0.03 -0.00
temp <- output.ancova[32:34,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Self-Reported Sleep") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Self-Reported Sleep
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
sleep_quality_change Sleep Quality -0.02 0.10 0.21 0.09 -0.22 (-0.38, -0.07) 0.08 2.87 309.41 0.004 -0.30 -0.32
sleep_amount_change Usual Sleep Amount -0.08 0.05 0.02 0.04 -0.10 (-0.18, -0.02) 0.04 2.48 282.76 0.014 -0.23 -0.28
wake_episodes_change Wake Episodes -0.01 0.15 -0.04 0.14 0.02 (-0.21, 0.26) 0.12 -0.21 301.48 0.837 0.01 0.02

For sleep quality, lower numbers are better where 1 is very good sleep quality and 5 is very poor sleep quality so higher number of change in sleep quality is worse. Recall for sleep amount 1 is more than usual, 2 is usual, and 3 is much less sleep than usual.

temp <- output.ancova[35:49,-c(10, 11, 15:(ncol(output.ancova)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
SRBAI_change SRBAI Habit Strength 0.87 0.31 0.41 0.15 0.46 (-0.18, 1.11) 0.31 -1.48 31.15 0.149 0.48 0.51
Avg1_change Considering Portion Sizes 1.14 0.26 0.66 0.23 0.48 (0.08, 0.89) 0.21 -2.35 242.56 0.020 0.25 0.29
Avg2_change Tracking Food Consumption 1.46 0.29 0.91 0.26 0.54 (0.08, 1.01) 0.24 -2.29 248.70 0.023 0.22 0.28
Avg3_change Consider WW Points 3.67 0.28 1.04 0.25 2.63 (2.19, 3.08) 0.23 -11.67 281.27 <0.001 1.28 1.35
Avg4_change Frequency of Eating Vegetables 0.68 0.22 0.42 0.19 0.27 (-0.07, 0.61) 0.17 -1.54 263.11 0.125 0.15 0.18
Avg5_change Frequency of Weighing Self 1.11 0.70 0.43 0.23 0.67 (-0.72, 2.07) 0.68 -0.99 26.76 0.331 0.31 0.35
Avg6_change Frequency of Physical Activity 0.61 0.60 0.21 0.21 0.40 (-0.82, 1.61) 0.59 -0.67 28.06 0.508 0.22 0.23
Avg7_change Talking Kindly to Self After Setback 0.77 0.26 0.45 0.21 0.32 (-0.11, 0.74) 0.22 -1.48 203.77 0.140 0.24 0.19
Avg8_change Arranging Healthy Foods for Easy Access 1.17 0.28 0.66 0.25 0.51 (0.06, 0.95) 0.23 -2.24 284.41 0.026 0.23 0.26
Avg9_change Frequency of Fried Foods -0.54 0.26 -0.17 0.23 -0.37 (-0.78, 0.04) 0.21 1.80 262.05 0.073 -0.23 -0.21
Avg10_change Frequency of Sweets -1.46 0.26 -0.68 0.23 -0.78 (-1.18, -0.37) 0.21 3.73 281.14 <0.001 -0.40 -0.43
Avg11_change Frequency of Sugary Beverages -0.77 0.23 -0.36 0.21 -0.40 (-0.78, -0.03) 0.19 2.14 294.08 0.033 -0.21 -0.24
Avg12_change Snacking When Not Hungry -0.73 0.24 -0.49 0.21 -0.25 (-0.62, 0.13) 0.19 1.29 304.31 0.200 -0.15 -0.14
UnhSRBAI_change Unhealthy Grouped -0.87 0.16 -0.42 0.14 -0.45 (-0.70, -0.20) 0.13 3.50 324.36 <0.001 -0.37 -0.38
healSRBAI_change Healthy Grouped 1.31 0.13 0.58 0.12 0.73 (0.53, 0.93) 0.10 -7.09 311.19 <0.001 0.73 0.79

Model Assumption Diagnostics

Model assumptions of normality and equal variance of residuals were evaluated for each outcome (Casella 2021, Glass 1996, Glass 1972). Rules of thumb are that data can be considered approximately normal where |skewness| <1; and equal variance can be considered with (0.5<(Var1/Var2)<2) (Blanca 2018, Glass 1972). However, analyses are robust to larger values of skewness (i.e. type-I error rates are maintained) with large sample sizes due to the central limit theorem; and unequal variance can be mitigated with approximately equal sample sizes between groups.

Histograms

Histograms of residuals from the model of one selected imputation.

Dietary quality

Change in ASA24 HEI Diet Quality Scores (Total and Subscores)

# Plot residuals from first imputation
colnames(outcome_pairs)[which(colnames(outcome_pairs) == "outcomes")] = "outcome"

residual_hist_df <- subset(residual_list_dietqual1, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[1:14])

# highlight values 3 away from 0 as outliers
hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)


ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5002 HEI2015C7_TOTPROT_change Total Protein Foods -4.586 Weight Watchers
WINS5027 HEI2015C7_TOTPROT_change Total Protein Foods -3.336 Weight Watchers
WINS5039 HEI2015_TOTAL_SCORE_change HEI Total Score -3.301 Control
WINS5039 HEI2015C11_REFINEDGRAIN_change Refined Grains -3.065 Control
WINS5063 HEI2015C3_TOTALFRUIT_change Total Fruit 3.169 Weight Watchers
WINS5066 HEI2015C13_ADDSUG_change Added Sugars -4.639 Weight Watchers
WINS5067 HEI2015C6_TOTALDAIRY_change Total Dairy 3.116 Weight Watchers
WINS5074 HEI2015_TOTAL_SCORE_change HEI Total Score 3.350 Control
WINS5080 HEI2015C7_TOTPROT_change Total Protein Foods 3.754 Weight Watchers
WINS5088 HEI2015C1_TOTALVEG_change Total Vegetable -3.372 Control
WINS5093 HEI2015C7_TOTPROT_change Total Protein Foods -3.638 Weight Watchers
WINS5098 HEI2015C7_TOTPROT_change Total Protein Foods -3.971 Weight Watchers
WINS5102 HEI2015C4_WHOLEFRUIT_change Whole Fruit 3.075 Weight Watchers
WINS5116 HEI2015C4_WHOLEFRUIT_change Whole Fruit -3.046 Weight Watchers
WINS5129 HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 3.030 Control
WINS5129 HEI2015C7_TOTPROT_change Total Protein Foods -3.464 Control
WINS5129 HEI2015C11_REFINEDGRAIN_change Refined Grains -3.065 Control
WINS5153 HEI2015C7_TOTPROT_change Total Protein Foods -3.418 Weight Watchers
WINS5155 HEI2015C13_ADDSUG_change Added Sugars -3.436 Control
WINS5159 HEI2015C7_TOTPROT_change Total Protein Foods -4.326 Control
WINS5162 HEI2015C1_TOTALVEG_change Total Vegetable -3.252 Weight Watchers
WINS5162 HEI2015C7_TOTPROT_change Total Protein Foods -3.229 Weight Watchers
WINS5180 HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 3.028 Weight Watchers
WINS5193 HEI2015C7_TOTPROT_change Total Protein Foods -4.008 Control
WINS5199 HEI2015C7_TOTPROT_change Total Protein Foods -5.164 Weight Watchers
WINS5209 HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 3.216 Weight Watchers
WINS5220 HEI2015C13_ADDSUG_change Added Sugars -3.536 Weight Watchers
WINS5232 HEI2015C13_ADDSUG_change Added Sugars 3.003 Control
WINS5283 HEI2015C7_TOTPROT_change Total Protein Foods -4.077 Control
WINS5328 HEI2015C13_ADDSUG_change Added Sugars -3.219 Control
WINS5329 HEI2015C13_ADDSUG_change Added Sugars -3.157 Control
WINS5344 HEI2015C7_TOTPROT_change Total Protein Foods -3.565 Control
WINS5350 HEI2015C13_ADDSUG_change Added Sugars -4.355 Weight Watchers
WINS5355 HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 3.167 Weight Watchers
WINS5357 HEI2015C7_TOTPROT_change Total Protein Foods 4.011 Weight Watchers
WINS5400 HEI2015C13_ADDSUG_change Added Sugars -3.805 Control
WINS5407 HEI2015_TOTAL_SCORE_change HEI Total Score -3.231 Weight Watchers
WINS5407 HEI2015C11_REFINEDGRAIN_change Refined Grains -3.174 Weight Watchers
WINS5412 HEI2015C7_TOTPROT_change Total Protein Foods 4.037 Weight Watchers
WINS5427 HEI2015_TOTAL_SCORE_change HEI Total Score 3.278 Weight Watchers
WINS5437 HEI2015C1_TOTALVEG_change Total Vegetable -3.367 Weight Watchers

Other Dietary Quality Measures

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[15])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5062 amed_change AMED Score -3.053 Weight Watchers

Change in Average Micro and Macro Nutrients Between Endline and Baseline

residual_hist_df <- subset(residual_list_dietqual2, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[16:24])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)


ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5066 SUGR_ave_change Average Total Sugars 4.908 Weight Watchers
WINS5066 ADD_SUGARS_ave_change Average Added Sugars 5.984 Weight Watchers
WINS5079 FIBE_ave_change Average Fiber 3.519 Control
WINS5084 SODI_ave_change Average Sodium -3.490 Weight Watchers
WINS5101 CARB_ave_change Average Total Carbohydrates 3.590 Control
WINS5123 FIBE_ave_change Average Fiber 3.267 Weight Watchers
WINS5145 SFAT_ave_change Average Saturated Fats 3.014 Weight Watchers
WINS5165 FIBE_ave_change Average Fiber 3.982 Weight Watchers
WINS5166 SODI_ave_change Average Sodium 3.343 Control
WINS5193 KCAL_ave_change Average Total Energy 3.637 Control
WINS5193 CARB_ave_change Average Total Carbohydrates 3.293 Control
WINS5193 SUGR_ave_change Average Total Sugars 4.139 Control
WINS5193 ADD_SUGARS_ave_change Average Added Sugars 4.902 Control
WINS5195 KCAL_ave_change Average Total Energy 3.309 Control
WINS5195 TFAT_ave_change Average Total Fat 3.331 Control
WINS5195 SFAT_ave_change Average Saturated Fats 5.166 Control
WINS5195 SUGR_ave_change Average Total Sugars 3.259 Control
WINS5199 KCAL_ave_change Average Total Energy 3.004 Weight Watchers
WINS5199 SODI_ave_change Average Sodium 3.640 Weight Watchers
WINS5199 SFAT_ave_change Average Saturated Fats 4.790 Weight Watchers
WINS5216 SODI_ave_change Average Sodium 3.418 Control
WINS5218 FIBE_ave_change Average Fiber 7.814 Weight Watchers
WINS5236 ADD_SUGARS_ave_change Average Added Sugars -3.273 Control
WINS5238 ADD_SUGARS_ave_change Average Added Sugars 3.063 Weight Watchers
WINS5253 KCAL_ave_change Average Total Energy 3.418 Control
WINS5253 TFAT_ave_change Average Total Fat 5.127 Control
WINS5253 SFAT_ave_change Average Saturated Fats 3.502 Control
WINS5253 CHOLE_ave_change Average Total Cholesterol 3.176 Control
WINS5290 CHOLE_ave_change Average Total Cholesterol 7.374 Weight Watchers
WINS5310 KCAL_ave_change Average Total Energy 3.713 Weight Watchers
WINS5310 CARB_ave_change Average Total Carbohydrates 3.337 Weight Watchers
WINS5310 SUGR_ave_change Average Total Sugars 3.244 Weight Watchers
WINS5349 ADD_SUGARS_ave_change Average Added Sugars 3.477 Control
WINS5350 ADD_SUGARS_ave_change Average Added Sugars 3.583 Weight Watchers
WINS5358 SUGR_ave_change Average Total Sugars 3.328 Control
WINS5396 CHOLE_ave_change Average Total Cholesterol 3.105 Control
WINS5427 FIBE_ave_change Average Fiber 3.701 Weight Watchers
WINS5431 TFAT_ave_change Average Total Fat 3.100 Control
WINS5431 SFAT_ave_change Average Saturated Fats 3.340 Control
WINS5441 KCAL_ave_change Average Total Energy 3.577 Control
WINS5441 TFAT_ave_change Average Total Fat 4.606 Control
WINS5441 SFAT_ave_change Average Saturated Fats 3.338 Control
WINS5444 CARB_ave_change Average Total Carbohydrates 3.620 Weight Watchers

Weight loss

residual_hist_df <- subset(residual_list_weightloss, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[25:30])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)


ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5086 weightkg_change Body Weight (kg) -3.111 Weight Watchers
WINS5086 BMI_change BMI -3.355 Weight Watchers
WINS5123 weightkg_change Body Weight (kg) -4.893 Weight Watchers
WINS5123 BMI_change BMI -4.335 Weight Watchers
WINS5123 changekg_percent_body_wt Percent Body Weight Change -4.187 Weight Watchers
WINS5185 weightkg_change Body Weight (kg) -3.270 Control
WINS5185 BMI_change BMI -3.442 Control
WINS5216 weightkg_change Body Weight (kg) -5.083 Control
WINS5216 BMI_change BMI -4.422 Control
WINS5216 changekg_percent_body_wt Percent Body Weight Change -4.269 Control
WINS5225 weightkg_change Body Weight (kg) -3.050 Control
WINS5427 weightkg_change Body Weight (kg) -4.715 Weight Watchers
WINS5427 BMI_change BMI -4.489 Weight Watchers
WINS5427 changekg_percent_body_wt Percent Body Weight Change -4.514 Weight Watchers

Behavioral

Change in Physical Activity

residual_hist_df <- subset(residual_list_behavioral1, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[31:34])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5060 sendentary_change Sedentary -3.083 Weight Watchers
WINS5066 METS_change Total Physical Activity MET 3.739 Weight Watchers
WINS5066 moderate_change Moderate 7.497 Weight Watchers
WINS5126 METS_change Total Physical Activity MET 4.532 Control
WINS5126 vigorous_change Vigorous 5.918 Control
WINS5129 METS_change Total Physical Activity MET 3.082 Control
WINS5144 moderate_change Moderate 3.131 Control
WINS5158 METS_change Total Physical Activity MET 3.686 Weight Watchers
WINS5158 moderate_change Moderate 4.955 Weight Watchers
WINS5164 METS_change Total Physical Activity MET -3.807 Control
WINS5164 moderate_change Moderate -3.444 Control
WINS5173 sendentary_change Sedentary 3.314 Control
WINS5176 sendentary_change Sedentary 3.317 Control
WINS5182 moderate_change Moderate 3.422 Control
WINS5217 sendentary_change Sedentary 3.388 Control
WINS5224 moderate_change Moderate 3.303 Weight Watchers
WINS5255 METS_change Total Physical Activity MET 3.947 Weight Watchers
WINS5255 vigorous_change Vigorous 3.242 Weight Watchers
WINS5263 METS_change Total Physical Activity MET 4.590 Weight Watchers
WINS5263 vigorous_change Vigorous 6.106 Weight Watchers
WINS5314 METS_change Total Physical Activity MET 4.587 Weight Watchers
WINS5314 sendentary_change Sedentary 4.140 Weight Watchers
WINS5314 vigorous_change Vigorous 7.022 Weight Watchers
WINS5328 METS_change Total Physical Activity MET 4.999 Control
WINS5328 moderate_change Moderate 4.628 Control
WINS5336 METS_change Total Physical Activity MET 4.506 Control
WINS5336 vigorous_change Vigorous 6.522 Control

Change in Self-Reported Sleep

residual_hist_df <- subset(residual_list_behavioral2, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[35:37])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

For sleep quality, lower numbers are better where 1 is very good sleep quality and 5 is very poor sleep quality so higher number of change in sleep quality is worse. Recall for sleep amount 1 is more than usual, 2 is usual, and 3 is much less sleep than usual.


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5068 sleep_amount_change Usual Sleep Amount 3.044 Control
WINS5121 sleep_quality_change Sleep Quality -3.013 Weight Watchers
WINS5121 sleep_amount_change Usual Sleep Amount -3.094 Weight Watchers
WINS5206 wake_episodes_change Wake Episodes 3.457 Control
WINS5210 wake_episodes_change Wake Episodes 6.690 Weight Watchers
WINS5294 wake_episodes_change Wake Episodes 7.309 Control
WINS5319 wake_episodes_change Wake Episodes 3.130 Weight Watchers
WINS5378 sleep_quality_change Sleep Quality 3.215 Control
WINS5379 sleep_amount_change Usual Sleep Amount 3.043 Weight Watchers
WINS5438 sleep_amount_change Usual Sleep Amount 3.058 Control

Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)

residual_hist_df <- subset(residual_list_behavioral3, .imp == 1) %>% 
  dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[38:52])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")


Standardized residuals that are more than 3 away from zero:

hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5041 Avg3_change Consider WW Points -4.354 Weight Watchers
WINS5071 Avg8_change Arranging Healthy Foods for Easy Access -3.077 Control
WINS5116 Avg4_change Frequency of Eating Vegetables 3.038 Weight Watchers
WINS5122 Avg3_change Consider WW Points -3.670 Weight Watchers
WINS5127 Avg1_change Considering Portion Sizes 3.938 Control
WINS5130 Avg3_change Consider WW Points -3.491 Control
WINS5194 healSRBAI_change Healthy Grouped -3.037 Control
WINS5203 Avg4_change Frequency of Eating Vegetables -3.099 Control
WINS5227 Avg5_change Frequency of Weighing Self 3.133 Control
WINS5286 healSRBAI_change Healthy Grouped -3.116 Weight Watchers
WINS5289 Avg1_change Considering Portion Sizes 3.641 Weight Watchers
WINS5290 Avg6_change Frequency of Physical Activity 3.102 Weight Watchers
WINS5294 healSRBAI_change Healthy Grouped -3.113 Control
WINS5298 Avg1_change Considering Portion Sizes 3.749 Control
WINS5298 Avg5_change Frequency of Weighing Self 3.096 Control
WINS5333 Avg4_change Frequency of Eating Vegetables -3.386 Weight Watchers
WINS5359 Avg1_change Considering Portion Sizes 3.024 Weight Watchers
WINS5359 Avg8_change Arranging Healthy Foods for Easy Access 3.075 Weight Watchers
WINS5364 Avg1_change Considering Portion Sizes 3.178 Weight Watchers
WINS5364 Avg4_change Frequency of Eating Vegetables 3.084 Weight Watchers
WINS5414 UnhSRBAI_change Unhealthy Grouped -3.235 Control
WINS5427 UnhSRBAI_change Unhealthy Grouped -3.316 Weight Watchers

Diagnostics

Table of diagnostic statistics of standardized model residuals

imput_diag_tab = output.ancova %>% 
  dplyr::select(Outcome, Outcome_label, 
                Mean_Skewness,
                #Min_Skewness,
                Max_Skewness,
                Mean_Kurtosis,
                #Min_Kurtosis, 
                Max_Kurtosis,
                Levene_Pvalue, 
                Min_Levene,
                #Max_Levene, 
                Variance_Residual_Ratio,
                Variance_Residual_Ratio_Min,
                Variance_Residual_Ratio_Max)
#Variance_Outcome_Ratio,
#Variance_Outcome_Ratio_Min,
#Variance_Outcome_Ratio_max) 

imput_diag_tab <- imput_diag_tab %>% dplyr::filter(!Outcome %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")) 

kable(imput_diag_tab,
      row.names = FALSE,
      col.names = c("Outcome", "Label", 
                    "Mean", "Max", #skew
                    "Mean", "Max", #kurt
                    "Mean", "Min", #"Max", #levene
                    "Mean", "Min", "Max" # var resid ratio
      )) %>% # var outcome ratio
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Skewness" = 2, "Kurtosis" = 2, "Levene's P-value"=2,
                     "Ratio of Variance" = 3)) %>%
  pack_rows(index = c("Change ASA24 in HEI Diet Quality Scores" = 14,
                      "Other Dietary Quality Measures" = 1,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 3,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
Skewness
Kurtosis
Levene’s P-value
Ratio of Variance
Outcome Label Mean Max Mean Max Mean Min Mean Min Max
Change ASA24 in HEI Diet Quality Scores
HEI2015_TOTAL_SCORE_change HEI Total Score 0.03 0.14 3.07 3.33 0.386 0.134 1.01 0.82 1.22
HEI2015C1_TOTALVEG_change Total Vegetable -0.44 0.58 3.15 3.52 0.650 0.302 1.00 0.83 1.20
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans -0.27 0.45 2.44 2.84 0.134 0.021 1.00 0.86 1.17
HEI2015C3_TOTALFRUIT_change Total Fruit 0.11 0.24 2.66 3.03 0.110 0.013 1.03 0.72 1.39
HEI2015C4_WHOLEFRUIT_change Whole Fruit -0.06 0.19 2.69 3.10 0.320 0.008 1.03 0.66 1.37
HEI2015C5_WHOLEGRAIN_change Whole Grains 0.53 0.66 2.86 3.07 0.443 0.260 1.01 0.85 1.17
HEI2015C6_TOTALDAIRY_change Total Dairy 0.06 0.16 2.43 2.65 0.734 0.435 1.00 0.89 1.10
HEI2015C7_TOTPROT_change Total Protein Foods -2.39 3.14 12.33 16.40 0.181 0.040 1.10 0.57 1.74
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins -0.50 0.77 2.80 3.28 0.178 0.036 1.04 0.71 1.40
HEI2015C9_FATTYACID_change Fatty Acids 0.08 0.25 2.63 3.13 0.245 0.049 1.03 0.76 1.37
HEI2015C10_SODIUM_change Sodium 0.44 0.54 2.92 3.32 0.768 0.441 1.00 0.89 1.11
HEI2015C11_REFINEDGRAIN_change Refined Grains -0.48 0.64 2.84 3.36 0.081 0.018 1.01 0.78 1.25
HEI2015C12_SFAT_change Saturated Fats -0.11 0.26 2.51 3.02 0.146 0.021 1.03 0.75 1.42
HEI2015C13_ADDSUG_change Added Sugars -1.35 1.53 6.13 6.57 0.569 0.314 1.00 0.92 1.08
Other Dietary Quality Measures
amed_change AMED Score 0.14 0.25 2.89 3.28 0.413 0.126 1.02 0.76 1.35
Change in Micro and Macro Nutrients
KCAL_ave_change Average Total Energy 0.79 0.89 4.63 4.94 0.541 0.205 1.02 0.74 1.30
TFAT_ave_change Average Total Fat 0.98 1.08 5.94 6.33 0.129 0.041 1.06 0.64 1.57
CARB_ave_change Average Total Carbohydrates 0.59 0.67 3.85 4.03 0.787 0.338 1.00 0.82 1.15
SODI_ave_change Average Sodium 0.65 0.73 3.99 4.20 0.473 0.181 1.01 0.83 1.27
SFAT_ave_change Average Saturated Fats 1.17 1.25 6.32 6.58 0.187 0.075 1.01 0.78 1.28
SUGR_ave_change Average Total Sugars 1.03 1.16 5.85 6.22 0.474 0.212 1.01 0.82 1.20
ADD_SUGARS_ave_change Average Added Sugars 1.58 1.73 8.57 9.23 0.215 0.068 1.01 0.81 1.23
CHOLE_ave_change Average Total Cholesterol 1.35 1.65 9.97 11.22 0.374 0.149 1.01 0.86 1.18
FIBE_ave_change Average Fiber 1.75 1.93 12.66 13.57 0.462 0.090 1.09 0.64 1.77
Weight Loss Measures
weightkg_change Body Weight (kg) -1.04 1.23 5.92 6.77 0.561 0.143 1.02 0.71 1.44
BMI_change BMI -0.79 0.95 4.97 5.60 0.557 0.155 1.02 0.73 1.38
changekg_percent_body_wt Percent Body Weight Change -0.80 0.99 4.69 5.44 0.542 0.143 1.02 0.73 1.38
Change in Physical Activity
METS_change Total Physical Activity MET 1.80 1.89 9.95 10.33 0.887 0.634 1.00 0.88 1.15
sendentary_change Sedentary 0.50 0.65 4.95 5.32 0.713 0.411 1.01 0.86 1.20
moderate_change Moderate 2.29 2.46 14.48 15.50 0.806 0.566 1.04 0.73 1.37
vigorous_change Vigorous 3.14 3.34 20.06 21.27 0.640 0.379 1.02 0.81 1.28
Change Self-Reported Sleep
sleep_quality_change Sleep Quality 0.26 0.37 3.49 3.96 0.644 0.213 1.01 0.79 1.30
sleep_amount_change Usual Sleep Amount 0.15 0.26 4.30 4.68 0.309 0.060 1.01 0.78 1.22
wake_episodes_change Wake Episodes 2.21 2.48 14.90 16.16 0.777 0.492 1.01 0.87 1.14
Change in Habit Strength
SRBAI_change SRBAI Habit Strength -0.17 0.64 3.72 4.29 0.459 0.020 1.02 0.66 1.50
Avg1_change Considering Portion Sizes 0.09 0.44 3.50 4.43 0.534 0.069 1.01 0.79 1.31
Avg2_change Tracking Food Consumption 0.42 0.62 2.97 3.62 0.658 0.063 1.00 0.81 1.33
Avg3_change Consider WW Points 0.14 0.24 3.03 3.81 0.742 0.251 1.00 0.85 1.25
Avg4_change Frequency of Eating Vegetables -0.42 0.69 4.45 5.08 0.462 0.036 1.02 0.67 1.48
Avg5_change Frequency of Weighing Self 0.15 0.61 3.07 3.96 0.598 0.004 1.00 0.72 1.53
Avg6_change Frequency of Physical Activity -0.04 0.42 2.92 3.54 0.702 0.101 1.00 0.81 1.24
Avg7_change Talking Kindly to Self After Setback 0.02 0.30 3.16 3.93 0.546 0.059 1.01 0.79 1.25
Avg8_change Arranging Healthy Foods for Easy Access -0.21 0.49 3.11 4.00 0.627 0.045 1.00 0.84 1.24
Avg9_change Frequency of Fried Foods 0.12 0.31 3.24 3.74 0.605 0.104 1.00 0.82 1.23
Avg10_change Frequency of Sweets -0.19 0.41 3.15 3.82 0.602 0.061 1.00 0.76 1.31
Avg11_change Frequency of Sugary Beverages -0.14 0.61 4.40 5.38 0.430 0.023 1.02 0.64 1.62
Avg12_change Snacking When Not Hungry -0.30 0.48 3.63 4.69 0.417 0.017 1.01 0.71 1.46
UnhSRBAI_change Unhealthy Grouped 0.10 0.21 4.36 4.87 0.345 0.041 1.03 0.68 1.48
healSRBAI_change Healthy Grouped 0.22 0.39 3.59 4.00 0.431 0.077 1.01 0.75 1.32

Maximum skewness is maximum |skewness|.

The three logistic models for binary outcomes percent body weight loss achieved are not included in this table.

Sensitivity Analysis

Outliers Removed

A sensitivity analysis excluding observations with standardized residuals >|3| was conducted to assess the impact of outliers.

###########
## Setup ##
###########

# First remove all the observations with |resid| > 3.
# Diet quality
for (out in unique(residual_list_dietqual1$outcome)){
  residual_list_dietqual1[which(residual_list_dietqual1$outcome == out & abs(residual_list_dietqual1$residuals) > 3),out] = NA
}
for (out in unique(residual_list_dietqual2$outcome)){
  residual_list_dietqual2[which(residual_list_dietqual2$outcome == out & abs(residual_list_dietqual2$residuals) > 3),out] = NA
}

# Weight loss
for (out in unique(residual_list_weightloss$outcome)){
      # 3 logistic models had no |residuals|>3 so use percent weight change flags (else results same as primary)
    if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")){
        residual_list_weightloss[which(residual_list_weightloss$outcome == "changekg_percent_body_wt" & abs(residual_list_weightloss$residuals) > 3),out] = NA
    } else{
  residual_list_weightloss[which(residual_list_weightloss$outcome == out & abs(residual_list_weightloss$residuals) > 3),out] = NA
    }
}

# Behavioral
for (out in unique(residual_list_behavioral1$outcome)){
  residual_list_behavioral1[which(residual_list_behavioral1$outcome == out & abs(residual_list_behavioral1$residuals) > 3),out] = NA
}
for (out in unique(residual_list_behavioral2$outcome)){
  residual_list_behavioral2[which(residual_list_behavioral2$outcome == out & abs(residual_list_behavioral2$residuals) > 3),out] = NA
}
for (out in unique(residual_list_behavioral3$outcome)){
  residual_list_behavioral3[which(residual_list_behavioral3$outcome == out & abs(residual_list_behavioral3$residuals) > 3),out] = NA
}

#####################

# Save reference levels
residual_list_dietqual1 <- imputed_references(residual_list_dietqual1)
residual_list_dietqual2 <- imputed_references(residual_list_dietqual2)
residual_list_weightloss <- imputed_references(residual_list_weightloss)
residual_list_behavioral1 <- imputed_references(residual_list_behavioral1)
residual_list_behavioral2 <- imputed_references(residual_list_behavioral2)
residual_list_behavioral3 <- imputed_references(residual_list_behavioral3)


# setup output shell table
cols <- c("Outcome", "Outcome_label", "Mean1", "SE1", "Mean2", "SE2", "Mean_Diff",
          "Mean_Diff_LB", "Mean_Diff_UB",
          "SE_Diff", "Estimate", "SE", "t", "df", "p_value", "Mean_Skewness", "Min_Skewness", 
          "Max_Skewness", "Mean_Kurtosis","Min_Kurtosis",  "Max_Kurtosis", "Levene_Pvalue", 
          "Min_Levene","Max_Levene", "Variance_Residual_Ratio", "Variance_Residual_Ratio_Min", 
          "Variance_Residual_Ratio_Max", "Variance_Outcome_Ratio", "Variance_Outcome_Ratio_Min",
          "Variance_Outcome_Ratio_max", "Number of Participants", "Cohens_d_unadjusted", "Cohens_d_adjusted")
output_sens = matrix(nrow = length(outcomes), ncol = length(cols))
colnames(output_sens) = cols

# models
# "achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl", "weight_change"
# get weight_bl as baseline measurement
##############
## Modeling ##
##############

# save residuals from one imputation for model assumption checks
residual_list <- data.frame()
print = "no"

for (out in outcomes){
  
    # setup model formula:
  if (out %in%  c("changekg_percent_body_wt", "achieve_3_percent_wl", "achieve_5_percent_wl", 
                  "achieve_10_percent_wl" # weight loss
  )){ # these outcomes dont match the _change, _bl structure
    formula = paste0(" ~ weightkg_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment")
  } else{formula = paste0("~ ", gsub("_change", "_bl", out), # everything else
                          " + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment")} 
  
  # extract data of interest since had to break up data when saving all residuals:
  if(out %in% unique(residual_list_dietqual1$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_dietqual1, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } else if(out %in% unique(residual_list_dietqual2$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_dietqual2, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } else if(out %in% unique(residual_list_behavioral1$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_behavioral1, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } else if(out %in% unique(residual_list_behavioral2$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_behavioral2, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } else if(out %in% unique(residual_list_behavioral3$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_behavioral3, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } else if(out %in% unique(residual_list_weightloss$outcome)){
    imputed.analysis.data = dplyr::filter(residual_list_weightloss, outcome == out)
    imputed.analysis.data <- imputed.analysis.data[, !(colnames(imputed.analysis.data) %in% c("residuals", "outcome"))]
  } 
  
  # setup model:
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic
    primary.model <- plyr::dlply(imputed.analysis.data, ".imp", function(df)
      glm(as.formula(paste(out, formula)), data = df, family = "binomial"))
    
  } else{
    # ANCOVA
    primary.model <- plyr::dlply(imputed.analysis.data, ".imp", function(df)
      lm(as.formula(paste(out, formula)), data = df))
    
  }
  
  # Difference between groups:
  emm.model <- as.mira(primary.model)
  # this command is used so that the emmeans packages recognizes that emm.model is a list of imputed models.
  # this is necessary so that the results are pooled using rubin's rules (https://github.com/rvlenth/emmeans/issues/80)
  
  # emmeans is different for logistic vs lm: 
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic
    emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
    
    # to get OR CI:
    emm.pairs.CI = confint( pairs(emmeans(emm.model, "Treatment", type = "response")))
    
  } else{
    # ANCOVA
    emm <- emmeans::emmeans(emm.model, "Treatment", data = imputed.analysis.data) # estimate, SE, df, z, p
    
    # pairs or pairwise
    emm.pairs = pairs(emmeans(emm.model, "Treatment", data = imputed.analysis.data)) # T1 - T2 estiamte SD df z p
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
      # to get OR CI:
    emm.pairs.CI = confint( pairs(emmeans(emm.model, "Treatment", data = imputed.analysis.data)))
  }
  
  # Error running stats on residual because lists of uneven lengths:
  s.resids <- lapply(primary.model, rstandard) # list of 200
  s.resids376 <- s.resids
  
  # filling in NAs for participants dropped:
  for (i in 1:length(s.resids)){
    resid.df <- data.frame(row.names = 1:376)
    temp <- as.data.frame(unlist(s.resids[[i]]), row.names = names(s.resids[[i]]))
    colnames(temp) <- "residuals"
    resid.df <- merge(resid.df, temp, by = "row.names", all = TRUE)
    resid.df$Row.names <- as.numeric(resid.df$Row.names)
    resid.df <- resid.df[order(resid.df$Row.names),]
    rownames(resid.df)  = resid.df$Row.names
    resid.df <- resid.df[,-1]
    s.resids376[[i]] <- resid.df
  }

  
  # Diagnostics:
  
  # skewness on standardized residuals
  skewness.mean <- mean(sapply(s.resids, moments::skewness))
  skewness.max <- max( abs( sapply(s.resids, moments::skewness) )) 
  skewness.min <- min(sapply(s.resids, moments::skewness))
  
  # save residuals from the imputed models back onto the data set
  # by adding a new column for the standardized residuals from each model
  imputed.data.resids <- cbind(imputed.analysis.data,
                               data.frame(residuals = unlist(s.resids376, use.names = FALSE)))
  # factor treatment to group by later
  imputed.data.resids$Treatment = factor(imputed.data.resids$Treatment)
  
  # save residuals from first imputation from all outcomes for histograms
  temp <- imputed.data.resids %>% subset(.imp == 1) %>%
    dplyr::select(c(".imp", ".id", "WINS.ID", "Treatment", "residuals")) %>%
    mutate(outcome = out)
  
    residual_list <- rbind(residual_list, 
                           temp) 
  
  
  # run the levene's test on each dataset individually, then extract just the p-value from the test
  levene <- dlply(imputed.data.resids, ".imp", function(df)
    car::leveneTest(residuals ~ Treatment, data = df)$`Pr(>F)`[1])
  
  levene.pval <- mean(unlist(levene))
  levene.min <- min(unlist(levene))
  levene.max <- max(unlist(levene))
  
  # calculate the ratio of residual variance
  # first calculate the variance of residuals by group, by imputation.
  imputed.data.resids <- imputed.data.resids %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(variance.resids = var(residuals, na.rm = TRUE), .groups = "keep")
  # then group by just imputation to compare the two variances
  imputed.data.resids <- imputed.data.resids %>%
    group_by(.imp) %>% 
    dplyr::summarise(ratio.var.resid = 
                       variance.resids[Treatment == rownames(table(imputed.analysis.data$Treatment))[1]]/
                       variance.resids[Treatment == rownames(table(imputed.analysis.data$Treatment))[2]])
  # mean, min, max
  variance.residual.ratio.mean <- mean(imputed.data.resids$ratio.var.resid)
  variance.residual.ratio.min <- min(imputed.data.resids$ratio.var.resid)
  variance.residual.ratio.max <- max(imputed.data.resids$ratio.var.resid)
  # and above to take the mean across all imputation sets
  
  # calculate kurtosis mean, max, min
  kurtosis.mean <- mean(sapply(s.resids, moments::kurtosis))
  kurtosis.max <- max(sapply(s.resids, moments::kurtosis))
  kurtosis.min <- min(sapply(s.resids, moments::kurtosis))
  
  # calculate the ratio of outcome variance
  # first calculate the variance of outcome by group, by imputation
  variance.outcome.ratios <- imputed.analysis.data %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(variance.outcome = var(.data[[out]], na.rm = TRUE), .groups = "keep")
  # then group by just imputation to compare the two variances
  variance.outcome.ratios <- variance.outcome.ratios %>% group_by(.imp) %>% 
    dplyr::summarise(variance.outcome.ratio = 
                       variance.outcome[Treatment == rownames(table(imputed.analysis.data$Treatment))[1]]/
                       variance.outcome[Treatment == rownames(table(imputed.analysis.data$Treatment))[2]])
  # mean, min, max
  variance.outcome.ratio.mean <- mean(variance.outcome.ratios$variance.outcome.ratio)
  variance.outcome.ratio.min <- min(variance.outcome.ratios$variance.outcome.ratio)
  variance.outcome.ratio.max <- max(variance.outcome.ratios$variance.outcome.ratio)
  
  # Report measure of effect size, Cohen's d 
  # on imputed for each imputed data set and average across for all outcomes
  
  # Cohen’s d is calculated from means and SD for differences between groups, 
  # where d=(Mean1-Mean2)/SD
  
  # Calculate effect size components by imputation and treatment (for non-binary):
  # first calculate components by imputation and treatment
  effect_size <- imputed.analysis.data %>% group_by(.imp, Treatment) %>% 
    dplyr::summarise(Mean = mean(.data[[out]], na.rm = TRUE),
                     SD = stats:::sd(.data[[out]], na.rm = TRUE),
                     n = sum(!is.na(.data[[out]])),
                     .groups = "keep")
  
  # then calculate effect size by imputation (no longer grouping by treatment)
  effect_size2 <- effect_size %>% group_by(.imp) %>%
    dplyr::summarise(cohensd = (Mean[Treatment == 1] - Mean[Treatment == 2]) / 
                       sqrt( ((n[Treatment == 1] - 1) * SD[Treatment == 1]^2 +
                                (n[Treatment == 2] - 1) * SD[Treatment == 2]^2) / 
                               (n[Treatment == 1] + n[Treatment == 2] - 2)
                       ),
                     .groups = "keep")
  
  
  # Calculate cohens d from model, adjusting for covariates:
  effect_size2$cohensd2 <- NA
  # emmeans is different for logistic vs lm: 
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    
    # for logistic the effect size is the odds ratio
    
    # logistic
    # emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    # emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    # pairs(emmeans(emm.model, "Treatment"), reverse = TRUE) # T2 - T1
    
    effect_size2$cohensd2  = data.frame(emm.pairs)$odds.ratio
    
  } else{
    
    for (iter in 1:max(imputed.analysis.data$.imp)){
      # ANCOVA
      emm_iter <- emmeans::emmeans(primary.model[[iter]], "Treatment") # estimate, SE, df, z, p
      
      # pairs or pairwise
      emm.pairs_iter = pairs(emmeans(primary.model[[iter]], "Treatment")) # T1 - T2 estiamte SD df z p
      
      contrast = data.frame(emm.pairs_iter)
      effect_size2[iter, "cohensd2"] <- data.frame(eff_size(emm_iter, 
                                                            sigma = sigma(primary.model[[iter]]), 
                                                            edf = contrast[, "df"]))$effect.size
    }
  }
  
  
  n_participants <- mean(sapply(s.resids, length))
  
  
  # Save differently for different models:
  if (out %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", 
                 "achieve_10_percent_wl")){
    # logistic
    #emm <- emmeans::emmeans(emm.model, "Treatment", type = "response")  # prob, SE, df, asymp.LCL asymp.UCL
    
    # pairs or pairwise
    #emm.pairs = pairs(emmeans(emm.model, "Treatment", type = "response")) # T1 / T2,  OR SE df null z p 
    
    output_sens[which(outcomes == out),] =
      c(out, outcome_pairs$outcome_labels[which(outcome_pairs$outcome == out)],
        summary(emm)$prob[1], summary(emm)$SE[1], # prob and SE X
        summary(emm)$prob[2], summary(emm)$SE[2], # prob and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$odds.ratio, emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
    
  } else{
    # ANCOVA
    #emm <- emmeans::emmeans(emm.model, "Treatment") # estimate, SE, df, z, p
    
    # pairs or pairwise
    #emm.pairs = pairs(emmeans(emm.model, "Treatment")) # T1 - T2 estiamte SD df z p
    
    output_sens[which(outcomes == out),] =
      c(out, outcome_pairs$outcome_labels[which(outcome_pairs$outcome == out)],
        summary(emm)$emmean[1], summary(emm)$SE[1], # mean and SE X
        summary(emm)$emmean[2], summary(emm)$SE[2], # mean and SE Y
        # difference in groups treatment groups:
        c(summary(emm.pairs)$estimate, emm.pairs.CI$lower.CL, emm.pairs.CI$upper.CL, summary(emm.pairs)$SE),
        unlist(summary(pool(primary.model))[which(summary(pool(primary.model))$term == "Treatment2"),2:6]),
        skewness.mean, skewness.min, skewness.max, 
        kurtosis.mean, kurtosis.min, kurtosis.max, 
        levene.pval, levene.min, levene.max, 
        variance.residual.ratio.mean, variance.residual.ratio.min, variance.residual.ratio.max,
        variance.outcome.ratio.mean, variance.outcome.ratio.min, variance.outcome.ratio.max,
        n_participants,
        mean(effect_size2$cohensd), mean(effect_size2$cohensd2) # cohens d
      )
    
  }
  
  # Optionl returns while loop running:
  if(print == "yes"){
    #print(paste(out, formula))
    print(paste0(out, " outcome ", which(outcomes == out), " of ", length(outcomes),"."))
  }
}

# Combined model results
output_sens = as.data.frame(output_sens)

# save output table:
save(output_sens, residual_list,
     file = paste0("WINS_Main_Analysis_outlier_", Sys.Date(), ".RData"))
# load saved output from chunk above:
load("WINS_Main_Analysis_outlier_2025-01-28.RData")

output_sens_saved <- output_sens
output_sens[,3:ncol(output_sens)] = apply(output_sens[,3:ncol(output_sens)], 2, as.numeric)

# format p-values:
output_sens <- output_sens %>% 
  mutate(
    p_value = case_when(.data[["p_value"]] < 0.001 ~ sub(" ", "", format.pval(.data[["p_value"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["p_value"]], digits = 3, format = "f")),
    Levene_Pvalue = case_when(.data[["Levene_Pvalue"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Levene_Pvalue"]], eps = 0.001, digits = 3, nsmall=3)),
                              TRUE ~ formatC(.data[["Levene_Pvalue"]], digits = 3, format = "f")),
    Min_Levene = case_when(.data[["Min_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Min_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Min_Levene"]], digits = 3, format = "f")),
    Max_Levene = case_when(.data[["Max_Levene"]] < 0.001 ~ sub(" ", "", format.pval(.data[["Max_Levene"]], eps = 0.001, digits = 3, nsmall=3)),
                           TRUE ~ formatC(.data[["Max_Levene"]], digits = 3, format = "f"))
    
  )

# round non-pvalues to 2 decimal places
p_values = which(cols %in% c("p_value", "Levene_Pvalue",
                             "Min_Levene", "Max_Levene"))
log_output_sens <- output_sens
non_pvals <- setdiff(3:ncol(output_sens), p_values)
output_sens[,non_pvals] = apply(output_sens[,non_pvals], 2, function(x) sprintf("%.2f", x))

rownames(output_sens) = NULL

# to keep outcome pairs indices, combine CI:
temp = outcome_pairs %>% dplyr::rename(Outcome = outcome) %>% 
  dplyr::rename(Outcome_label = outcome_labels)

output_sens <- merge(temp, output_sens, by = c("Outcome", "Outcome_label"), sort = FALSE) #all = TRUE,
output_sens <- output_sens %>% mutate(
  Mean_Diff_CI = paste0("(", Mean_Diff_LB, ", ", Mean_Diff_UB, ")")
)  %>%
  select(-Mean_Diff_LB, -Mean_Diff_UB) %>%
  select(
    Outcome, Outcome_label, Mean1, SE1, Mean2, SE2, Mean_Diff, 
    Mean_Diff_CI, SE_Diff, Estimate, SE, t, df, p_value, 
    Mean_Skewness, Min_Skewness, Max_Skewness, Mean_Kurtosis, Min_Kurtosis, 
    Max_Kurtosis, Levene_Pvalue, Min_Levene, Max_Levene, 
    Variance_Residual_Ratio, Variance_Residual_Ratio_Min, 
    Variance_Residual_Ratio_Max, Variance_Outcome_Ratio, 
    Variance_Outcome_Ratio_Min, Variance_Outcome_Ratio_max, 
    `Number of Participants`, Cohens_d_unadjusted, Cohens_d_adjusted
  )

Model Results

Dietary quality

kable(output_sens[1:14,-c(10, 11, 15:(ncol(output_sens)-2))],
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"),
      caption = "Change in ASA24 HEI Diet Quality Scores (Total and Subscores)") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in ASA24 HEI Diet Quality Scores (Total and Subscores)
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
HEI2015_TOTAL_SCORE_change HEI Total Score 5.32 1.51 1.12 1.38 4.20 (1.82, 6.58) 1.21 -3.47 331.33 <0.001 0.30 0.37
HEI2015C1_TOTALVEG_change Total Vegetable 0.18 0.17 0.06 0.15 0.12 (-0.14, 0.38) 0.13 -0.92 292.51 0.357 0.08 0.10
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 0.89 0.28 0.18 0.25 0.71 (0.27, 1.15) 0.22 -3.18 292.18 0.002 0.21 0.35
HEI2015C3_TOTALFRUIT_change Total Fruit 0.48 0.24 -0.05 0.21 0.53 (0.15, 0.91) 0.19 -2.76 289.55 0.006 0.27 0.31
HEI2015C4_WHOLEFRUIT_change Whole Fruit 0.12 0.26 -0.38 0.23 0.50 (0.09, 0.92) 0.21 -2.37 307.76 0.018 0.21 0.26
HEI2015C5_WHOLEGRAIN_change Whole Grains 1.05 0.43 0.58 0.40 0.47 (-0.22, 1.16) 0.35 -1.34 316.38 0.183 0.07 0.15
HEI2015C6_TOTALDAIRY_change Total Dairy -0.52 0.39 -0.24 0.35 -0.28 (-0.90, 0.34) 0.31 0.89 296.79 0.376 -0.02 -0.10
HEI2015C7_TOTPROT_change Total Protein Foods 0.08 0.09 0.05 0.08 0.02 (-0.12, 0.17) 0.07 -0.30 241.45 0.762 0.05 0.04
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 0.24 0.27 0.10 0.24 0.14 (-0.29, 0.57) 0.22 -0.65 313.47 0.518 -0.01 0.07
HEI2015C9_FATTYACID_change Fatty Acids 1.22 0.46 0.95 0.40 0.26 (-0.45, 0.97) 0.36 -0.73 278.26 0.469 0.08 0.08
HEI2015C10_SODIUM_change Sodium -1.08 0.36 -0.83 0.33 -0.24 (-0.82, 0.33) 0.29 0.83 307.00 0.406 -0.01 -0.09
HEI2015C11_REFINEDGRAIN_change Refined Grains 0.55 0.44 -0.59 0.39 1.14 (0.44, 1.84) 0.36 -3.20 280.26 0.002 0.33 0.36
HEI2015C12_SFAT_change Saturated Fats 1.51 0.45 0.89 0.40 0.62 (-0.09, 1.33) 0.36 -1.73 299.31 0.085 0.14 0.19
HEI2015C13_ADDSUG_change Added Sugars 0.60 0.28 0.45 0.25 0.15 (-0.30, 0.61) 0.23 -0.67 277.72 0.503 0.02 0.08
temp <- output_sens[15,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), 
      caption = "Other Dietary Quality Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Other Dietary Quality Measures
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
amed_change AMED Score 0.86 0.65 0.18 0.59 0.68 (-0.35, 1.71) 0.52 -1.30 319.72 0.195 0.10 0.14
temp <- output_sens[16:24,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), 
      caption = "Change in Average Micro and Macro Nutrients Between Endline and Baseline") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Average Micro and Macro Nutrients Between Endline and Baseline
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
KCAL_ave_change Average Total Energy -468.15 70.55 -242.35 64.89 -225.81 (-338.23, -113.39) 57.14 3.95 317.47 <0.001 -0.27 -0.43
TFAT_ave_change Average Total Fat -22.27 3.79 -9.96 3.48 -12.31 (-18.25, -6.37) 3.02 4.08 325.20 <0.001 -0.27 -0.44
CARB_ave_change Average Total Carbohydrates -50.48 8.55 -26.69 7.76 -23.79 (-37.32, -10.26) 6.88 3.46 310.14 <0.001 -0.27 -0.38
SODI_ave_change Average Sodium -553.86 131.29 -183.10 118.05 -370.75 (-574.44, -167.06) 103.52 3.58 313.19 <0.001 -0.27 -0.39
SFAT_ave_change Average Saturated Fats -8.37 1.44 -4.17 1.30 -4.20 (-6.47, -1.93) 1.15 3.64 317.99 <0.001 -0.25 -0.40
SUGR_ave_change Average Total Sugars -25.23 4.76 -17.74 4.33 -7.49 (-14.94, -0.05) 3.79 1.98 324.52 0.049 -0.10 -0.22
ADD_SUGARS_ave_change Average Added Sugars -5.01 0.98 -3.19 0.88 -1.83 (-3.37, -0.28) 0.78 2.33 310.58 0.021 -0.14 -0.26
CHOLE_ave_change Average Total Cholesterol -48.80 22.88 -23.41 20.29 -25.39 (-61.59, 10.81) 18.39 1.38 276.84 0.168 -0.07 -0.16
FIBE_ave_change Average Fiber -1.85 0.97 -1.46 0.87 -0.39 (-1.92, 1.14) 0.78 0.51 272.52 0.614 -0.03 -0.06

These measurements were averaged across the ASA24 recalls at endline and baseline, and then the difference was taken (endline - baseline).

Weight loss

Outliers for significant weight loss were more often found in the Weight Watchers group (and in some cases, participants with significant weight gain were flagged as outliers from the Control group). When we remove these for the sensitivity analysis, the difference between the two groups are sometimes less significant.

temp <- output_sens[25:27,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Weight Loss Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Weight Loss Measures
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
weightkg_change Body Weight (kg) -5.39 0.93 -1.54 0.81 -3.86 (-5.29, -2.42) 0.73 5.29 243.21 <0.001 -0.60 -0.61
BMI_change BMI -1.87 0.32 -0.54 0.28 -1.33 (-1.83, -0.84) 0.25 5.28 244.96 <0.001 -0.60 -0.61
changekg_percent_body_wt Percent Body Weight Change -5.43 0.93 -1.52 0.81 -3.91 (-5.35, -2.47) 0.73 5.34 256.01 <0.001 -0.61 -0.61

For the three logistic outcomes (achievement of a certain percentage of weight loss), since it’s binary there weren’t any outliers flagged with |standardized residuals|>3. As a result, we flagged outliers for these variables using the same outliers determined by the Percent Body Weight Change outcome.

temp <- output_sens[28:30,-c(10, 11, 15:(ncol(output_sens)))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Probability", "SE", "Probability", "SE", "OR", "95% CI", "SE", "z", "df", "p-value"), caption = "Logisitc Weight Loss Measures") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3))
Logisitc Weight Loss Measures
Weight Watchers
Control
Difference
Model Statistics
Variable Outcome Probability SE Probability SE OR 95% CI SE z df p-value
achieve_3_percent_wl Achieved 3% Weight Loss 0.59 0.07 0.35 0.06 2.68 (1.70, 4.25) 0.63 -4.21 277.66 <0.001
achieve_5_percent_wl Achieved 5% Weight Loss 0.47 0.08 0.21 0.05 3.34 (2.07, 5.38) 0.81 -4.96 299.75 <0.001
achieve_10_percent_wl Achieved 10% Weight Loss 0.19 0.08 0.03 0.02 7.10 (3.18, 15.84) 2.91 -4.79 272.74 <0.001

Behavioral

temp <- output_sens[31:34,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Physical Activity") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Physical Activity
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
METS_change Total Physical Activity MET 665.68 347.08 750.90 318.86 -85.23 (-626.96, 456.51) 275.28 0.31 298.49 0.757 -0.05 -0.03
sendentary_change Sedentary -69.20 26.89 -37.17 23.97 -32.03 (-74.43, 10.36) 21.50 1.49 208.37 0.138 -0.15 -0.18
moderate_change Moderate 226.39 216.28 286.31 198.88 -59.93 (-399.58, 279.72) 172.59 0.35 295.93 0.729 -0.04 -0.04
vigorous_change Vigorous 507.39 229.66 514.31 210.09 -6.92 (-375.57, 361.72) 187.26 0.04 276.48 0.971 -0.03 -0.00
temp <- output_sens[35:37,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Self-Reported Sleep") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Self-Reported Sleep
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
sleep_quality_change Sleep Quality -0.02 0.10 0.21 0.09 -0.22 (-0.38, -0.07) 0.08 2.85 305.79 0.005 -0.30 -0.31
sleep_amount_change Usual Sleep Amount -0.08 0.05 0.02 0.04 -0.10 (-0.18, -0.02) 0.04 2.47 274.67 0.014 -0.23 -0.28
wake_episodes_change Wake Episodes -0.01 0.15 -0.04 0.14 0.03 (-0.21, 0.27) 0.12 -0.21 281.09 0.832 0.01 0.02

For sleep quality, lower numbers are better where 1 is very good sleep quality and 5 is very poor sleep quality so higher number of change in sleep quality is worse. Recall for sleep amount 1 is more than usual, 2 is usual, and 3 is much less sleep than usual.

temp <- output_sens[38:52,-c(10, 11, 15:(ncol(output_sens)-2))]
rownames(temp) = NULL
kable(temp,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value", "unadjusted", "adjusted"), caption = "Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference"=3, "Model Statistics" = 3, "Cohen's d" = 2))
Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)
Weight Watchers
Control
Difference
Model Statistics
Cohen’s d
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value unadjusted adjusted
SRBAI_change SRBAI Habit Strength 0.87 0.31 0.41 0.15 0.47 (-0.18, 1.11) 0.31 -1.48 31.34 0.149 0.48 0.51
Avg1_change Considering Portion Sizes 1.14 0.26 0.66 0.23 0.48 (0.07, 0.89) 0.21 -2.32 236.33 0.021 0.25 0.29
Avg2_change Tracking Food Consumption 1.46 0.30 0.91 0.26 0.54 (0.08, 1.01) 0.24 -2.29 249.33 0.023 0.22 0.28
Avg3_change Consider WW Points 3.67 0.28 1.04 0.25 2.63 (2.18, 3.08) 0.23 -11.59 275.07 <0.001 1.28 1.35
Avg4_change Frequency of Eating Vegetables 0.68 0.22 0.42 0.19 0.27 (-0.08, 0.61) 0.18 -1.52 255.43 0.129 0.15 0.18
Avg5_change Frequency of Weighing Self 1.11 0.70 0.43 0.23 0.67 (-0.72, 2.07) 0.68 -0.99 26.66 0.331 0.31 0.35
Avg6_change Frequency of Physical Activity 0.61 0.60 0.21 0.21 0.40 (-0.81, 1.61) 0.59 -0.67 28.14 0.507 0.22 0.23
Avg7_change Talking Kindly to Self After Setback 0.77 0.26 0.45 0.21 0.32 (-0.11, 0.75) 0.22 -1.48 202.67 0.141 0.24 0.19
Avg8_change Arranging Healthy Foods for Easy Access 1.17 0.28 0.66 0.25 0.51 (0.06, 0.96) 0.23 -2.23 282.14 0.026 0.23 0.26
Avg9_change Frequency of Fried Foods -0.54 0.26 -0.17 0.23 -0.37 (-0.79, 0.04) 0.21 1.78 258.52 0.076 -0.23 -0.21
Avg10_change Frequency of Sweets -1.46 0.26 -0.68 0.23 -0.78 (-1.19, -0.37) 0.21 3.73 280.30 <0.001 -0.40 -0.43
Avg11_change Frequency of Sugary Beverages -0.77 0.24 -0.36 0.21 -0.40 (-0.78, -0.03) 0.19 2.12 292.53 0.035 -0.21 -0.24
Avg12_change Snacking When Not Hungry -0.73 0.24 -0.49 0.21 -0.24 (-0.62, 0.13) 0.19 1.27 302.56 0.204 -0.15 -0.14
UnhSRBAI_change Unhealthy Grouped -0.87 0.16 -0.42 0.15 -0.45 (-0.70, -0.20) 0.13 3.48 319.76 <0.001 -0.37 -0.38
healSRBAI_change Healthy Grouped 1.31 0.13 0.58 0.12 0.73 (0.53, 0.93) 0.10 -7.07 308.12 <0.001 0.73 0.79

Comparison

# Compare raw p-values:
comparison <- merge(primary_results[,c("Outcome_label", "p_value")], output_sens_saved[,c("Outcome_label", "p_value")], 
                    by = "Outcome_label", suffixes = c(".primary", ".sens"), sort = FALSE)

# make p-values numeric
comparison$p_value.primary = as.numeric(comparison$p_value.primary)
comparison$p_value.sens = as.numeric(comparison$p_value.sens)

comparison <- comparison %>% mutate(
  change = case_when(p_value.primary < 0.05 & p_value.sens < 0.05 ~ "No Change",
                     p_value.primary > 0.05 & p_value.sens > 0.05 ~ "No Change",
                     p_value.primary < 0.05 & p_value.sens > 0.05 ~ "Change",
                     p_value.primary > 0.05 & p_value.sens < 0.05 ~ "Change")
)

table(comparison$change)
## 
## No Change 
##        52

All 52 of the 52 outcomes did not change in level of significance between the primary and outlier removed sensitivity analysis.

Model Assumption Checks

Model assumptions of normality and equal variance of residuals will be evaluated for each outcome. Normality of residuals will be considered satisfied with a skewness <|2| given large sample sizes and; and equal variance between groups will be considered satisfied with (0.5<(Var1/Var2)<2) with approximately balanced group sizes. Significance tests for baseline differences will not be conducted per CONSORT guidelines. A sensitivity analysis excluding observations with standardized residuals >|3| will be conducted to assess the impact of outliers.

Histograms

Histograms of residuals from the model of one selected imputation.

Dietary quality

Change in ASA24 HEI Diet Quality Scores (Total and Subscores)

# Plot residuals from first imputation
colnames(outcome_pairs)[which(colnames(outcome_pairs) == "outcomes")] = "outcome"

residual_hist_df <- subset(residual_list, .imp == 1) %>% dplyr::select("WINS.ID","residuals", "outcome", "Treatment")

# Unblind treatment groups:
residual_hist_df$Treatment <- as.character(residual_hist_df$Treatment)
residual_hist_df$Treatment[residual_hist_df$Treatment == "1"] = "Weight Watchers"
residual_hist_df$Treatment[residual_hist_df$Treatment == "2"] = "Control"

residual_hist_df <- merge(outcome_pairs, residual_hist_df, by = "outcome", sort = FALSE)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[1:14])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5039 HEI2015_TOTAL_SCORE_change HEI Total Score -3.302 Control
WINS5039 HEI2015C11_REFINEDGRAIN_change Refined Grains -3.060 Control
WINS5074 HEI2015_TOTAL_SCORE_change HEI Total Score 3.335 Control
WINS5088 HEI2015C1_TOTALVEG_change Total Vegetable -3.363 Control
WINS5129 HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 3.033 Control
WINS5129 HEI2015C7_TOTPROT_change Total Protein Foods -3.403 Control
WINS5129 HEI2015C11_REFINEDGRAIN_change Refined Grains -3.096 Control
WINS5155 HEI2015C13_ADDSUG_change Added Sugars -3.397 Control
WINS5159 HEI2015C7_TOTPROT_change Total Protein Foods -4.244 Control
WINS5163 HEI2015C7_TOTPROT_change Total Protein Foods -3.850 Weight Watchers
WINS5193 HEI2015C7_TOTPROT_change Total Protein Foods -3.956 Control
WINS5283 HEI2015C7_TOTPROT_change Total Protein Foods -4.011 Control
WINS5328 HEI2015C13_ADDSUG_change Added Sugars -3.189 Control
WINS5329 HEI2015C13_ADDSUG_change Added Sugars -3.108 Control
WINS5344 HEI2015C7_TOTPROT_change Total Protein Foods -3.527 Control
WINS5350 HEI2015C7_TOTPROT_change Total Protein Foods -3.502 Weight Watchers
WINS5364 HEI2015C7_TOTPROT_change Total Protein Foods -3.069 Weight Watchers
WINS5400 HEI2015C13_ADDSUG_change Added Sugars -3.757 Control
WINS5444 HEI2015C7_TOTPROT_change Total Protein Foods -3.078 Weight Watchers

Other Dietary Quality Measures

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[15])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
NA NA NA NA NA
:——- :——- :————– ———: :———

Change in Average Micro and Macro Nutrients Between Endline and Baseline

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[16:24])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5079 FIBE_ave_change Average Fiber 3.844 Control
WINS5101 CARB_ave_change Average Total Carbohydrates 3.611 Control
WINS5166 SODI_ave_change Average Sodium 3.309 Control
WINS5193 KCAL_ave_change Average Total Energy 3.593 Control
WINS5193 CARB_ave_change Average Total Carbohydrates 3.281 Control
WINS5193 SUGR_ave_change Average Total Sugars 4.179 Control
WINS5193 ADD_SUGARS_ave_change Average Added Sugars 4.885 Control
WINS5195 KCAL_ave_change Average Total Energy 3.283 Control
WINS5195 TFAT_ave_change Average Total Fat 3.312 Control
WINS5195 SFAT_ave_change Average Saturated Fats 5.127 Control
WINS5195 SUGR_ave_change Average Total Sugars 3.256 Control
WINS5216 SODI_ave_change Average Sodium 3.395 Control
WINS5216 FIBE_ave_change Average Fiber 3.165 Control
WINS5236 ADD_SUGARS_ave_change Average Added Sugars -3.246 Control
WINS5238 SUGR_ave_change Average Total Sugars 3.135 Weight Watchers
WINS5253 KCAL_ave_change Average Total Energy 3.405 Control
WINS5253 TFAT_ave_change Average Total Fat 5.153 Control
WINS5253 SFAT_ave_change Average Saturated Fats 3.512 Control
WINS5253 CHOLE_ave_change Average Total Cholesterol 3.092 Control
WINS5349 ADD_SUGARS_ave_change Average Added Sugars 3.483 Control
WINS5358 SUGR_ave_change Average Total Sugars 3.232 Control
WINS5373 ADD_SUGARS_ave_change Average Added Sugars 3.248 Weight Watchers
WINS5396 CHOLE_ave_change Average Total Cholesterol 3.106 Control
WINS5431 TFAT_ave_change Average Total Fat 3.090 Control
WINS5431 SFAT_ave_change Average Saturated Fats 3.322 Control
WINS5441 KCAL_ave_change Average Total Energy 3.562 Control
WINS5441 TFAT_ave_change Average Total Fat 4.603 Control
WINS5441 SFAT_ave_change Average Saturated Fats 3.328 Control
WINS5444 ADD_SUGARS_ave_change Average Added Sugars 3.273 Weight Watchers

Weight loss

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[25:30])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5134 weightkg_change Body Weight (kg) -3.355 Weight Watchers
WINS5185 weightkg_change Body Weight (kg) -3.273 Control
WINS5185 BMI_change BMI -3.448 Control
WINS5216 weightkg_change Body Weight (kg) -5.070 Control
WINS5216 BMI_change BMI -4.408 Control
WINS5216 changekg_percent_body_wt Percent Body Weight Change -4.256 Control
WINS5225 weightkg_change Body Weight (kg) -3.045 Control

Behavioral

Change in Physical Activity

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[31:34])


hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5098 moderate_change Moderate -3.179 Weight Watchers
WINS5126 METS_change Total Physical Activity MET 4.500 Control
WINS5126 vigorous_change Vigorous 5.872 Control
WINS5129 METS_change Total Physical Activity MET 3.077 Control
WINS5144 moderate_change Moderate 3.111 Control
WINS5154 sendentary_change Sedentary 3.098 Weight Watchers
WINS5158 sendentary_change Sedentary -3.002 Weight Watchers
WINS5164 METS_change Total Physical Activity MET -3.589 Control
WINS5164 moderate_change Moderate -3.405 Control
WINS5173 sendentary_change Sedentary 3.277 Control
WINS5176 sendentary_change Sedentary 3.286 Control
WINS5182 moderate_change Moderate 3.401 Control
WINS5217 sendentary_change Sedentary 3.359 Control
WINS5226 vigorous_change Vigorous 3.330 Weight Watchers
WINS5255 moderate_change Moderate 3.153 Weight Watchers
WINS5328 METS_change Total Physical Activity MET 5.005 Control
WINS5328 moderate_change Moderate 4.592 Control
WINS5336 METS_change Total Physical Activity MET 4.504 Control
WINS5336 vigorous_change Vigorous 6.490 Control

Change in Self-Reported Sleep

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[35:37])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

For sleep quality, lower numbers are better where 1 is very good sleep quality and 5 is very poor sleep quality so higher number of change in sleep quality is worse. Recall for sleep amount 1 is more than usual, 2 is usual, and 3 is much less sleep than usual.

# table of outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5068 sleep_amount_change Usual Sleep Amount 3.037 Control
WINS5093 wake_episodes_change Wake Episodes 3.057 Weight Watchers
WINS5153 wake_episodes_change Wake Episodes 3.059 Weight Watchers
WINS5206 wake_episodes_change Wake Episodes 3.420 Control
WINS5294 wake_episodes_change Wake Episodes 7.273 Control
WINS5378 sleep_quality_change Sleep Quality 3.206 Control
WINS5438 sleep_amount_change Usual Sleep Amount 3.049 Control

Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy)

hist1 <- subset(residual_hist_df, outcome %in% outcome_pairs$outcome[38:52])

hist1 <- hist1 %>% dplyr::group_by(outcome) %>%
  mutate(Mean = base::mean(residuals, na.rm = TRUE),
         UB = 3,
         LB = -3)

# remove NAs so dont get warning when plotting hist:
hist1 <- hist1[-which(is.na(hist1$residuals)),]

# highlight values 3 away from 0 as outliers
hist1$outliers = 0
hist1$outliers[hist1$residuals > hist1$UB] = 1
hist1$outliers[hist1$residuals < hist1$LB] = 1
hist1$outliers <- factor(hist1$outliers)

# histogram
ggplot(hist1, aes(x = residuals, fill = outliers)) +
  theme_bw() + geom_histogram(bins = 30) +
  theme(legend.position = "none") +
  facet_wrap(~outcome, scales = "free", ncol = 3) + 
  ggtitle("|Stand. Resid| > 3 in Red") + 
  scale_fill_manual(values = c("blue", "red")) + 
  geom_vline(aes(xintercept = Mean), color = "#000000", linewidth = 0.5) +
  geom_vline(aes(xintercept = UB), color = "#000000", linewidth = 0.5, linetype = "dashed") +
  geom_vline(aes(xintercept = LB), color = "#000000", linewidth = 0.5, linetype = "dashed")

# highlight values 3 away from 0 as outliers
hist1$residuals <- round(hist1$residuals, 3)

hist1 %>% dplyr::group_by(WINS.ID) %>% arrange(WINS.ID) %>%
  subset(!is.na(residuals) & outliers == 1) %>% 
  dplyr::select(WINS.ID, outcome, outcome_labels, residuals, Treatment) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() 
WINS.ID outcome outcome_labels residuals Treatment
WINS5054 Avg1_change Considering Portion Sizes 3.167 Weight Watchers
WINS5071 Avg8_change Arranging Healthy Foods for Easy Access -3.068 Control
WINS5085 Avg3_change Consider WW Points -3.061 Weight Watchers
WINS5127 Avg1_change Considering Portion Sizes 3.913 Control
WINS5130 Avg3_change Consider WW Points -3.487 Control
WINS5180 healSRBAI_change Healthy Grouped -3.019 Weight Watchers
WINS5194 healSRBAI_change Healthy Grouped -3.036 Control
WINS5203 Avg4_change Frequency of Eating Vegetables -3.074 Control
WINS5227 Avg5_change Frequency of Weighing Self 3.133 Control
WINS5294 healSRBAI_change Healthy Grouped -3.103 Control
WINS5298 Avg1_change Considering Portion Sizes 3.755 Control
WINS5298 Avg5_change Frequency of Weighing Self 3.096 Control
WINS5414 UnhSRBAI_change Unhealthy Grouped -3.206 Control

Diagnostics

Table of diagnostic statistics of model residuals

imput_diag_tab = output_sens %>% 
  dplyr::select(Outcome, Outcome_label, 
                Mean_Skewness,
                #Min_Skewness,
                Max_Skewness,
                Mean_Kurtosis,
                #Min_Kurtosis, 
                Max_Kurtosis,
                Levene_Pvalue, 
                Min_Levene,
                #Max_Levene, 
                Variance_Residual_Ratio,
                Variance_Residual_Ratio_Min,
                Variance_Residual_Ratio_Max)
#Variance_Outcome_Ratio,
#Variance_Outcome_Ratio_Min,
#Variance_Outcome_Ratio_max) 

imput_diag_tab <- imput_diag_tab %>% dplyr::filter(!outcomes %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")) 

kable(imput_diag_tab,
      row.names = FALSE,
      col.names = c("Outcome", "Label", 
                    "Mean", "Max", #skew
                    "Mean", "Max", #kurt
                    "Mean", "Min", #"Max", #levene
                    "Mean", "Min", "Max" # var resid ratio
      )) %>% # var outcome ratio
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Skewness" = 2, "Kurtosis" = 2, "Levene's P-value"=2,
                     "Ratio of Variance" = 3)) %>%
  pack_rows(index = c("Change ASA24 in HEI Diet Quality Scores" = 14,
                      "Other Dietary Quality Measures" = 1,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 3,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
Skewness
Kurtosis
Levene’s P-value
Ratio of Variance
Outcome Label Mean Max Mean Max Mean Min Mean Min Max
Change ASA24 in HEI Diet Quality Scores
HEI2015_TOTAL_SCORE_change HEI Total Score 0.03 0.14 3.06 3.31 0.394 0.115 1.01 0.82 1.23
HEI2015C1_TOTALVEG_change Total Vegetable -0.43 0.57 3.15 3.53 0.642 0.293 1.00 0.83 1.20
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans -0.27 0.44 2.43 2.84 0.136 0.021 1.00 0.86 1.18
HEI2015C3_TOTALFRUIT_change Total Fruit 0.11 0.23 2.66 3.02 0.110 0.013 1.03 0.72 1.39
HEI2015C4_WHOLEFRUIT_change Whole Fruit -0.06 0.19 2.68 3.10 0.328 0.006 1.03 0.66 1.38
HEI2015C5_WHOLEGRAIN_change Whole Grains 0.53 0.66 2.86 3.06 0.440 0.265 1.01 0.85 1.17
HEI2015C6_TOTALDAIRY_change Total Dairy 0.06 0.16 2.43 2.65 0.731 0.427 1.00 0.89 1.10
HEI2015C7_TOTPROT_change Total Protein Foods -2.41 3.08 12.35 15.91 0.222 0.026 1.12 0.50 2.42
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins -0.50 0.77 2.79 3.28 0.181 0.033 1.04 0.71 1.39
HEI2015C9_FATTYACID_change Fatty Acids 0.08 0.25 2.63 3.13 0.244 0.054 1.03 0.75 1.37
HEI2015C10_SODIUM_change Sodium 0.44 0.54 2.92 3.34 0.772 0.481 1.00 0.90 1.11
HEI2015C11_REFINEDGRAIN_change Refined Grains -0.48 0.64 2.84 3.36 0.081 0.014 1.01 0.78 1.25
HEI2015C12_SFAT_change Saturated Fats -0.11 0.26 2.51 3.02 0.146 0.023 1.03 0.75 1.42
HEI2015C13_ADDSUG_change Added Sugars -1.35 1.53 6.11 6.64 0.608 0.237 1.01 0.86 1.17
Other Dietary Quality Measures
amed_change AMED Score 0.14 0.25 2.89 3.28 0.413 0.131 1.02 0.76 1.36
Change in Micro and Macro Nutrients
KCAL_ave_change Average Total Energy 0.78 0.90 4.62 4.91 0.557 0.235 1.02 0.75 1.37
TFAT_ave_change Average Total Fat 0.96 1.06 5.83 6.32 0.141 0.040 1.06 0.64 1.62
CARB_ave_change Average Total Carbohydrates 0.59 0.68 3.84 4.07 0.777 0.337 1.00 0.82 1.16
SODI_ave_change Average Sodium 0.65 0.72 3.97 4.23 0.464 0.169 1.01 0.83 1.26
SFAT_ave_change Average Saturated Fats 1.15 1.25 6.27 6.81 0.192 0.071 1.02 0.72 1.43
SUGR_ave_change Average Total Sugars 1.03 1.17 5.83 6.42 0.501 0.190 1.01 0.82 1.23
ADD_SUGARS_ave_change Average Added Sugars 1.58 1.77 8.53 9.28 0.230 0.037 1.01 0.76 1.39
CHOLE_ave_change Average Total Cholesterol 1.33 1.67 9.85 11.38 0.376 0.022 1.01 0.84 1.20
FIBE_ave_change Average Fiber 1.70 1.98 12.28 13.59 0.467 0.033 1.08 0.64 1.57
Weight Loss Measures
weightkg_change Body Weight (kg) -1.03 1.21 5.88 6.85 0.571 0.136 1.02 0.70 1.44
BMI_change BMI -0.78 0.95 4.92 5.61 0.567 0.163 1.02 0.73 1.38
changekg_percent_body_wt Percent Body Weight Change -0.79 0.95 4.66 5.45 0.552 0.139 1.02 0.72 1.37
Change in Physical Activity
METS_change Total Physical Activity MET 1.78 2.02 9.91 10.78 0.825 0.182 1.01 0.60 1.55
sendentary_change Sedentary 0.49 0.65 4.91 5.34 0.706 0.361 1.01 0.82 1.30
moderate_change Moderate 2.27 2.60 14.39 17.07 0.794 0.372 1.05 0.66 1.71
vigorous_change Vigorous 3.10 3.42 19.90 21.73 0.622 0.398 1.02 0.71 1.59
Change Self-Reported Sleep
sleep_quality_change Sleep Quality 0.26 0.37 3.49 3.94 0.640 0.223 1.01 0.79 1.30
sleep_amount_change Usual Sleep Amount 0.15 0.26 4.29 4.68 0.308 0.067 1.01 0.78 1.21
wake_episodes_change Wake Episodes 2.19 2.49 14.75 16.64 0.753 0.197 1.01 0.81 1.34
Change in Habit Strength
SRBAI_change SRBAI Habit Strength -0.17 0.64 3.72 4.30 0.460 0.015 1.02 0.64 1.50
Avg1_change Considering Portion Sizes 0.09 0.44 3.50 4.41 0.534 0.070 1.01 0.78 1.31
Avg2_change Tracking Food Consumption 0.42 0.62 2.96 3.62 0.657 0.061 1.00 0.81 1.33
Avg3_change Consider WW Points 0.14 0.24 3.02 3.58 0.738 0.231 1.00 0.85 1.25
Avg4_change Frequency of Eating Vegetables -0.42 0.69 4.45 5.17 0.462 0.015 1.02 0.67 1.51
Avg5_change Frequency of Weighing Self 0.15 0.61 3.07 3.97 0.598 0.004 1.00 0.72 1.54
Avg6_change Frequency of Physical Activity -0.04 0.42 2.93 3.54 0.704 0.101 1.00 0.84 1.24
Avg7_change Talking Kindly to Self After Setback 0.02 0.24 3.15 3.78 0.548 0.058 1.01 0.79 1.26
Avg8_change Arranging Healthy Foods for Easy Access -0.21 0.48 3.11 3.99 0.626 0.045 1.00 0.84 1.24
Avg9_change Frequency of Fried Foods 0.12 0.30 3.24 3.78 0.604 0.093 1.00 0.80 1.24
Avg10_change Frequency of Sweets -0.19 0.41 3.15 3.82 0.604 0.073 1.00 0.76 1.31
Avg11_change Frequency of Sugary Beverages -0.14 0.60 4.40 5.51 0.435 0.026 1.02 0.65 1.61
Avg12_change Snacking When Not Hungry -0.30 0.51 3.63 4.70 0.421 0.015 1.01 0.72 1.45
UnhSRBAI_change Unhealthy Grouped 0.10 0.21 4.35 4.93 0.351 0.029 1.02 0.67 1.48
healSRBAI_change Healthy Grouped 0.22 0.44 3.59 4.01 0.432 0.085 1.01 0.76 1.32

Maximum skewness is maximum |skewness|.

The three logistic models for binary outcomes percent body weight loss achieved are not included in this table.

LMM

\[ Original \space score = baseline + Sex + Age + Race + Ethnicity + Education + \\ Treatment + Time + Treatment*Time + (1|WINS.ID) \]

# Thank you to Xiwei Chen for this code:

#######################
## Data prep for LMM ##
#######################

df.bl <- raw_data %>%
  dplyr::select(WINS.ID, ends_with("_bl")) %>%
  dplyr::rename_with(~str_remove(., '_bl')) %>%
  dplyr::mutate(Time = "baseline")

df.el <- raw_data %>%
  dplyr::select(WINS.ID, ends_with("_el")) %>%
  dplyr::rename_with(~str_remove(., '_el')) %>%
  dplyr::mutate(Time = "endline")

df.other <- raw_data %>% 
  dplyr::select(-c(ends_with("_el")))

df_long <- df.other %>% full_join(dplyr::bind_rows(df.bl, df.el), by = join_by(WINS.ID)) %>%
  arrange(WINS.ID, Time)

Model Results

# LMM on continuous outcomes with longitudinal data:
yvars = setdiff(outcomes, c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl", "changekg_percent_body_wt"))
output_lmm = NULL
output_lmm_raw = NULL

for (yvar in yvars){
  # Model
  formula = as.formula(paste0(gsub("_change", "", yvar), " ~ ", gsub("_change", "_bl", yvar), 
                              " + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment*Time + (1|WINS.ID)"))
  mod = lmer(formula, data = df_long)
  
  
  # Estimated means and contrasts
  em = emmeans(mod, revpairwise ~ Time|Treatment)
  contrast = data.frame(em$contrasts)
  did = data.frame(pairs(pairs(emmeans(mod, ~ Time|Treatment), reverse = TRUE), by = NULL))
  did_CI = confint(pairs(pairs(emmeans(mod, ~ Time|Treatment), reverse = TRUE), by = NULL))
  out = data.frame(Outcomes = yvar,
                   group1_mean = round(contrast[contrast$Treatment == "Weight Watchers", "estimate"], 2),
                   group1_se = round(contrast[contrast$Treatment == "Weight Watchers", "SE"], 2),
                   group2_mean = round(contrast[contrast$Treatment == "Control", "estimate"], 2),
                   group2_se = round(contrast[contrast$Treatment == "Control", "SE"], 2),
                   diff_mean = round(did[, "estimate"], 2),
                   diff_CI = paste0("(", sprintf("%.2f", did_CI[, "lower.CL"]), ", ", sprintf("%.2f", did_CI[, "upper.CL"]), ")"),
                   diff_se = round(did[, "SE"], 2),
                   diff_t = round(did[, "t.ratio"], 2),
                   diff_df = round(did[, "df"], 2),
                   diff_p = did[, "p.value"])
  
    out_raw = data.frame(Outcomes = yvar,
                   group1_mean = contrast[contrast$Treatment == "Weight Watchers", "estimate"],
                   group1_se = contrast[contrast$Treatment == "Weight Watchers", "SE"],
                   group2_mean = contrast[contrast$Treatment == "Control", "estimate"],
                   group2_se = contrast[contrast$Treatment == "Control", "SE"],
                   diff_mean = did[, "estimate"],
                   diff_LB = did_CI[, "lower.CL"],
                   diff_UB = did_CI[, "upper.CL"],
                   diff_se = did[, "SE"],
                   diff_t = did[, "t.ratio"],
                   diff_df = did[, "df"],
                   diff_p = did[, "p.value"])
  
  output_lmm = rbind(output_lmm, out)
  
  output_lmm_raw = rbind(output_lmm_raw, out_raw)
  
  # Optionl returns while loop running:
  #print(paste0(yvar, " outcome ", which(yvars == yvar), " of ", length(yvars),"."))
}

output_lmm_saved <- output_lmm

# combine output with labels, select desired columns, and remove _change from outcome names
output_lmm = output_lmm  %>% 
  dplyr::rename("outcome" = "Outcomes") %>% 
  left_join(outcome_pairs, by = "outcome") %>% 
  dplyr::select(1,12,2:11) %>% 
  mutate(outcome = gsub("_change", "", outcome))

output_lmm_raw = output_lmm_raw  %>% 
  dplyr::rename("outcome" = "Outcomes") %>% 
  left_join(outcome_pairs, by = "outcome") %>% 
  dplyr::select(1,13,2:12) %>% 
  mutate(outcome = gsub("_change", "", outcome))

# round to 2 places and keep both places:
non_pvals = c("group1_mean", "group1_se", "group2_mean", "group2_se", 
              "diff_mean", "diff_se", "diff_t", "diff_df")
output_lmm[,non_pvals] = apply(output_lmm[, non_pvals], 2, function(x) sprintf("%.2f", x))

# save for table 3 usage where round p-values differently:
output_lmm2 <- output_lmm

# round p-values to 3 places:
output_lmm2 <- output_lmm2 %>% 
  mutate(
    diff_p = case_when(.data[["diff_p"]] < 0.001 ~ sub(" ", "", format.pval(.data[["diff_p"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["diff_p"]], digits = 3, format = "f")))

# table of results
kable(output_lmm2,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value"),
      caption = "LMM on all people") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference" = 3, "Model Statistics" = 3)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6-4,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
LMM on all people
Weight Watchers
Control
Difference
Model Statistics
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value
Change in Dietary Quality Measures (including HEI subscores)
HEI2015_TOTAL_SCORE HEI Total Score 3.90 0.92 -0.07 0.89 3.97 (1.44, 6.50) 1.28 3.09 365.75 0.002
HEI2015C1_TOTALVEG Total Vegetable 0.21 0.09 0.10 0.09 0.10 (-0.15, 0.36) 0.13 0.80 365.75 0.425
HEI2015C2_GREEN_AND_BEAN Greens and Beans 0.50 0.16 -0.00 0.16 0.50 (0.06, 0.95) 0.23 2.22 365.74 0.027
HEI2015C3_TOTALFRUIT Total Fruit 0.52 0.14 0.00 0.13 0.51 (0.14, 0.89) 0.19 2.71 365.73 0.007
HEI2015C4_WHOLEFRUIT Whole Fruit 0.37 0.15 -0.10 0.15 0.47 (0.05, 0.88) 0.21 2.21 365.74 0.028
HEI2015C5_WHOLEGRAIN Whole Grains 0.28 0.26 0.01 0.25 0.28 (-0.44, 0.99) 0.36 0.76 365.75 0.445
HEI2015C6_TOTALDAIRY Total Dairy -0.18 0.23 -0.12 0.22 -0.06 (-0.68, 0.57) 0.32 -0.17 365.75 0.862
HEI2015C7_TOTPROT Total Protein Foods 0.12 0.06 0.06 0.05 0.05 (-0.10, 0.21) 0.08 0.69 365.74 0.490
HEI2015C8_SEAPLANT_PROT Seafood and Plant Proteins -0.19 0.16 -0.16 0.16 -0.03 (-0.47, 0.41) 0.22 -0.14 365.74 0.889
HEI2015C9_FATTYACID Fatty Acids 0.61 0.26 0.30 0.25 0.31 (-0.41, 1.03) 0.37 0.84 365.74 0.399
HEI2015C10_SODIUM Sodium -0.64 0.22 -0.61 0.21 -0.03 (-0.62, 0.56) 0.30 -0.10 365.75 0.924
HEI2015C11_REFINEDGRAIN Refined Grains 0.78 0.26 -0.46 0.25 1.24 (0.52, 1.95) 0.36 3.41 365.75 <0.001
HEI2015C12_SFAT Saturated Fats 1.07 0.26 0.53 0.25 0.54 (-0.17, 1.24) 0.36 1.50 365.73 0.133
HEI2015C13_ADDSUG Added Sugars 0.44 0.16 0.37 0.16 0.08 (-0.37, 0.52) 0.23 0.33 365.73 0.741
amed AMED Score -0.06 0.38 -0.47 0.37 0.41 (-0.62, 1.45) 0.53 0.79 365.74 0.433
Change in Micro and Macro Nutrients
KCAL_ave Average Total Energy -420.17 43.94 -244.43 42.39 -175.74 (-295.81, -55.67) 61.06 -2.88 365.74 0.004
TFAT_ave Average Total Fat -21.25 2.33 -11.56 2.25 -9.68 (-16.06, -3.31) 3.24 -2.99 365.74 0.003
CARB_ave Average Total Carbohydrates -46.80 5.22 -28.13 5.03 -18.68 (-32.93, -4.42) 7.25 -2.58 365.73 0.010
SODI_ave Average Sodium -577.66 80.61 -267.65 77.76 -310.02 (-530.30, -89.73) 112.02 -2.77 365.74 0.006
SFAT_ave Average Saturated Fats -7.57 0.90 -4.13 0.87 -3.45 (-5.91, -0.98) 1.25 -2.75 365.74 0.006
SUGR_ave Average Total Sugars -17.72 2.86 -14.47 2.76 -3.25 (-11.08, 4.57) 3.98 -0.82 365.72 0.414
ADD_SUGARS_ave Average Added Sugars -3.76 0.60 -2.62 0.58 -1.14 (-2.77, 0.49) 0.83 -1.38 365.73 0.169
CHOLE_ave Average Total Cholesterol -39.48 13.31 -23.38 12.84 -16.09 (-52.47, 20.29) 18.50 -0.87 365.73 0.385
FIBE_ave Average Fiber -2.06 0.55 -1.89 0.53 -0.17 (-1.68, 1.34) 0.77 -0.22 365.75 0.825
Weight Loss Measures
weightkg Body Weight (kg) -5.45 0.44 -1.46 0.42 -3.99 (-5.19, -2.79) 0.61 -6.53 362.36 <0.001
BMI BMI -1.91 0.15 -0.51 0.15 -1.40 (-1.81, -0.99) 0.21 -6.67 362.35 <0.001
Change in Physical Activity
METS Total Physical Activity MET 497.70 199.11 564.63 190.98 -66.94 (-609.51, 475.64) 275.91 -0.24 362.47 0.808
sendentary Sedentary -68.19 14.27 -33.92 13.69 -34.27 (-73.15, 4.62) 19.77 -1.73 362.43 0.084
moderate Moderate 177.49 133.10 203.89 127.66 -26.40 (-389.09, 336.28) 184.43 -0.14 362.50 0.886
vigorous Vigorous 329.52 130.96 362.10 125.61 -32.58 (-389.45, 324.28) 181.47 -0.18 362.40 0.858
Change Self-Reported Sleep
sleep_quality Sleep Quality -0.05 0.05 0.18 0.05 -0.23 (-0.38, -0.08) 0.08 -3.02 365.74 0.003
sleep_amount Usual Sleep Amount -0.04 0.03 0.05 0.03 -0.10 (-0.18, -0.02) 0.04 -2.38 365.75 0.018
wake_episodes Wake Episodes -0.03 0.09 -0.04 0.08 0.01 (-0.22, 0.24) 0.12 0.08 364.55 0.937
Change in Habit Strength
SRBAI SRBAI Habit Strength 0.80 0.06 0.27 0.06 0.53 (0.36, 0.69) 0.08 6.29 362.48 <0.001
Avg1 Considering Portion Sizes 1.12 0.12 0.66 0.12 0.46 (0.12, 0.80) 0.17 2.66 362.46 0.008
Avg2 Tracking Food Consumption 1.27 0.14 0.79 0.14 0.48 (0.10, 0.86) 0.20 2.46 362.47 0.014
Avg3 Consider WW Points 3.34 0.14 0.69 0.14 2.64 (2.25, 3.04) 0.20 13.22 362.47 <0.001
Avg4 Frequency of Eating Vegetables 0.56 0.11 0.29 0.11 0.27 (-0.03, 0.57) 0.15 1.75 362.49 0.081
Avg5 Frequency of Weighing Self 1.01 0.13 0.42 0.12 0.59 (0.23, 0.94) 0.18 3.24 362.48 0.001
Avg6 Frequency of Physical Activity 0.68 0.12 0.37 0.11 0.32 (0.00, 0.63) 0.16 1.97 362.46 0.050
Avg7 Talking Kindly to Self After Setback 0.69 0.13 0.18 0.12 0.51 (0.15, 0.86) 0.18 2.83 362.48 0.005
Avg8 Arranging Healthy Foods for Easy Access 1.09 0.16 0.43 0.15 0.65 (0.23, 1.08) 0.22 3.01 362.43 0.003
Avg9 Frequency of Fried Foods -0.71 0.13 -0.28 0.12 -0.43 (-0.77, -0.09) 0.17 -2.50 362.48 0.013
Avg10 Frequency of Sweets -1.30 0.14 -0.50 0.13 -0.79 (-1.17, -0.42) 0.19 -4.17 362.48 <0.001
Avg11 Frequency of Sugary Beverages -0.79 0.13 -0.38 0.13 -0.42 (-0.77, -0.06) 0.18 -2.32 362.45 0.021
Avg12 Snacking When Not Hungry -0.79 0.13 -0.49 0.13 -0.29 (-0.66, 0.07) 0.19 -1.58 362.48 0.115
UnhSRBAI Unhealthy Grouped -0.90 0.09 -0.41 0.09 -0.49 (-0.74, -0.23) 0.13 -3.76 362.48 <0.001
healSRBAI Healthy Grouped 1.22 0.07 0.48 0.07 0.74 (0.54, 0.93) 0.10 7.36 362.48 <0.001

Note: there are four weight loss outcomes missing from the LMM Sensitivity analysis because they did not have an endline and baseline measure for longitudinal modeling.

Comparison

# let's merge the raw lmm output with the primary output to compare p-values
colnames(output_lmm)[2] = "Outcome_label"
comparison <- merge(primary_results[,c("Outcome_label", "p_value")], 
                    output_lmm[,c("Outcome_label", "diff_p")],
                    by = "Outcome_label", sort = FALSE)

# make p-values numeric
comparison$p_value = as.numeric(comparison$p_value)
comparison$diff_p = as.numeric(comparison$diff_p)
# add a variable indicating if p-values changed significance level
comparison <- comparison %>%  mutate(
  change = case_when(p_value < 0.05 & diff_p < 0.05 ~ "No Change",
                     p_value > 0.05 & diff_p > 0.05 ~ "No Change",
                     p_value < 0.05 & diff_p > 0.05 ~ "Change",
                     p_value > 0.05 & diff_p < 0.05 ~ "Change")
)

# format table to display changes
colnames(comparison) =c("Outcome", "Primary p-value", "LMM p-value", "Change")
comparison[,2:3] = round(comparison[,2:3], 3)

table(comparison$Change)
## 
##    Change No Change 
##         7        41

41 of the 48 outcomes did not change in level of significance between the primary and LMM sensitivity analysis.

The 7 outcomes that did result in a level of significant change are as follows:

comparison.flips <- comparison[which(comparison$Change == "Change"), -4]
comparison.flips$color = 0
comparison.flips$color[comparison.flips$`Primary p-value` < comparison.flips$`LMM p-value`] = 1
rownames(comparison.flips) = NULL
kable(comparison.flips[,-4]) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()  %>%
  row_spec(which(comparison.flips$color >0), color = "red") %>%
  row_spec(which(comparison.flips$color <1), color = "blue")
Outcome Primary p-value LMM p-value
Average Total Sugars 0.047 0.414
Average Added Sugars 0.019 0.169
SRBAI Habit Strength 0.149 0.000
Frequency of Weighing Self 0.331 0.001
Frequency of Physical Activity 0.508 0.050
Talking Kindly to Self After Setback 0.140 0.005
Frequency of Fried Foods 0.073 0.013

Bayes Factor

We are calculating the Bayes Factor for Total Sugars and Added Sugars because these two outcomes switched to being no longer significant in the LMM.

Bayes Factor is a metric to indicate the support of the null effect for no differences between groups. The Bayes Factor is an alternative to using p-values to quantify the level of support of the null hypothesis of no differences. It is calculated using a ratio of the likelihood of the model including group as a factor to the model not including group, where larger values indicate less evidence of the null effect. (see Andraszewicz, S., Scheibehenne, B., Rieskamp, J., Grasman, R., Verhagen, J., & Wagenmakers, E. J. (2015). An introduction to Bayesian hypothesis testing for management research. Journal of Management, 41(2), 521-543., and BayesFactor: Computation of Bayes Factors for Common Designs. https://cran.r-project.org/web/packages/BayesFactor/index.html)

Interpretation of Bayes factor (from Andraszewicz et al 2015):

Bayes factor Label
>100 Extreme evidence for H1
30-100 Very strong evidence for H1
10-30 Strong evidence for H1
3-10 Moderate evidence for H1
1-3 Anecdotal evidence for H1
1 No evidence
1/3 - 1 Anecdotal evidence for H0
1/10 - 1/3 Moderate evidence for H0
1/30 - 1/10 Strong evidence for H0
1/100 - 1/30 Very strong evidence for H0
<1/100 Extreme evidence evidence for H0

H\(_0\): Null hypothesis that states the absence of the effect
H\(_1\): Alternative hypothesis that states the presence of the effect
Ratio = H\(_1\)/H\(_0\)

A BF=10 indicates that the data is 10 times more likely under H\(_1\) than H\(_0\), while a BF=0.2 means that the data is 5 times more likely under H\(_0\) than H\(_1\).

ANCOVA+MI

Showing the Bayes Factor results for change in average total sugars and change in average added sugars from ANCOVA+MI.

outcome_list2 <- colnames(imputed_long_2[,15:16])


miBF_OUT2 <- NULL
for (i in 1:length(outcome_list2)){
  
 # i=1
  nimp=41 #max(imputed_long_2$.imp)
  vbf=bf=rep(0,nimp)
  
  for (j in 1:nimp){
  
#    j=1
    
    temp2 <- imputed_long_2[imputed_long_2$`.imp` == j,]
    temp2 <- temp2[,c("Sex_bcf","Age_years","Race2_bcf","Ethnicity_bcf","Education_grouped","Treatment",gsub("_change", "_bl", outcome_list2[i]),outcome_list2[i])]
    names(temp2)[names(temp2) == outcome_list2[i]] <- "outcome"
    names(temp2)[names(temp2) == gsub("_change", "_bl", outcome_list2[i])] <- "outcome_pre"
  
    # Bayes factor of full model against null
    bfFull = lmBF(outcome ~ Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + outcome_pre + Treatment, data = temp2)
    # Bayes factor of covariates only against null
    bfCov = lmBF(outcome ~ Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + outcome_pre, data = temp2)
    # Compare the two models
#    ratio = bfCov / bfFull #Xiweis code from APRE had it this way, but I think it should be this way 
    #https://richarddmorey.github.io/BayesFactor/#fixed
    #https://www.statisticshowto.com/bayes-factor-definition/
    ratio = bfFull / bfCov
    effect=extractBF(ratio)
    bf[j]=effect$bf
    vbf[j]=(nrow(temp2)-2)*effect$error^2
  }
  
  bf.bar=mean(bf)
  vbf.bar=mean(vbf)
  B=var(bf)
  S=vbf.bar+(1+(1/nimp))*B
  out2=data.frame(t(c(Outcome=outcome_list2[i], round((c(miBF=bf.bar, miError=sqrt(S))),2))))
  
  miBF_OUT2 <- rbind(miBF_OUT2,out2)
}

miBF_OUT2
##                 Outcome miBF miError
## 1       SUGR_ave_change 1.09    1.16
## 2 ADD_SUGARS_ave_change 2.87    2.57

Bayes Factor here is the ratio of the full model (covariates plus treatment group) divided by the covariate-only model: both Bayes factors are between 1 and 3 and thus there is only anecdotal evidence for treatment group.

LMM

Showing the Bayes Factor results for Average total sugars and average added sugars from LMM.

#Preparing the data for next chunk

#total sugar
df_long_sugar <- df_long %>% 
  drop_na(SUGR_ave) %>%
  select(SUGR_ave, SUGR_ave_bl, Sex_bcf, Age_years, Race2_bcf, Ethnicity_bcf, Education_grouped, Treatment, Time, WINS.ID)

df_long_sugar$Sex_bcf <- as.factor(df_long_sugar$Sex_bcf)  
df_long_sugar$Race2_bcf <- as.factor(df_long_sugar$Race2_bcf)  
df_long_sugar$Ethnicity_bcf <- as.factor(df_long_sugar$Ethnicity_bcf) 
df_long_sugar$Education_grouped <- as.factor(df_long_sugar$Education_grouped)  
df_long_sugar$Time <- as.factor(df_long_sugar$Time)  
df_long_sugar$WINS.ID <- as.factor(df_long_sugar$WINS.ID)  

#added sugar
df_long_add_sugar <- df_long %>% 
  drop_na(ADD_SUGARS_ave) %>%
  select(ADD_SUGARS_ave, ADD_SUGARS_ave_bl, Sex_bcf, Age_years, Race2_bcf, Ethnicity_bcf, Education_grouped, Treatment, Time, WINS.ID)

df_long_add_sugar$Sex_bcf <- as.factor(df_long_add_sugar$Sex_bcf)  
df_long_add_sugar$Race2_bcf <- as.factor(df_long_add_sugar$Race2_bcf)  
df_long_add_sugar$Ethnicity_bcf <- as.factor(df_long_add_sugar$Ethnicity_bcf) 
df_long_add_sugar$Education_grouped <- as.factor(df_long_add_sugar$Education_grouped)  
df_long_add_sugar$Time <- as.factor(df_long_add_sugar$Time)  
df_long_add_sugar$WINS.ID <- as.factor(df_long_add_sugar$WINS.ID)  
### Note: running this chunk takes around 8-10 hours !!!!

# References for Bayes Factor
#https://rpubs.com/mabbott/bayes
#https://richarddmorey.github.io/BayesFactor/
#https://www.statisticshowto.com/bayes-factor-definition/ --> this one is alternative over null
#https://www.r-bloggers.com/2015/01/what-does-a-bayes-factor-feel-like/ --> this one has BF > 1 favoring alternative


#Bayes Factor for total sugar
#Bayes Factor for total sugar
#Bayes Factor for total sugar

#mod_sugar <- lmer(SUGR_ave ~ SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment*Time + (1|WINS.ID), data = df_long)

#this next line is running all different combinations of all covariates and saves into bfsObject
bfsObject <- generalTestBF(SUGR_ave ~ SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment*Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_sugar, whichModels = "all")



#Bayes Factor for added sugar
#Bayes Factor for added sugar
#Bayes Factor for added sugar

#this next line is running all different combinations of all covariates and saves into bfsObject2
bfsObject2 <- generalTestBF(ADD_SUGARS_ave ~ ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment*Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_add_sugar, whichModels = "all")


save(bfsObject, bfsObject2,
     file = paste0("WINS_BayesFactor_LMM_", Sys.Date(), ".RData"))
# load in results from chunk above:
load("WINS_BayesFactor_LMM_2024-07-26.RData")

bfs <- bfsObject@bayesFactor
ln_bf_sugar <- 
  bfs["SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID + Treatment:Time", 1]  - 
  bfs["SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID", 1]


bf_sugar <- exp(ln_bf_sugar)
#bf_sugar


bfs2 <- bfsObject2@bayesFactor
ln_bf_add_sugar <- 
  bfs2["ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID + Treatment:Time", 1] -
  bfs2["ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID", 1]

bf_add_sugar <- exp(ln_bf_add_sugar)
#bf_add_sugar

bt_names <- c("Total sugars", "Added sugars")
bt_values <- c(round(bf_sugar, digits=3), round(bf_add_sugar, digits=3))
bayestableLMM <- data.frame(bt_names, bt_values)
names(bayestableLMM) <- c("Outcomes", "Bayes Factor")
print(bayestableLMM)
##       Outcomes Bayes Factor
## 1 Total sugars        0.163
## 2 Added sugars        0.298
#second way of doing this (slightly different numbers but way faster)
sugar_bf_int <- lmBF(SUGR_ave ~ SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + Treatment*Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_sugar)
sugar_bf_main <- lmBF(SUGR_ave ~ SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_sugar)
sugar_bf_int/sugar_bf_main
## Bayes factor analysis
## --------------
## [1] SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + Treatment * Time +     WINS.ID : 0.1542806 ±4.18%
## 
## Against denominator:
##   SUGR_ave ~ SUGR_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID 
## ---
## Bayes factor type: BFlinearModel, JZS
addsugar_bf_int <- lmBF(ADD_SUGARS_ave ~ ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + Treatment*Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_add_sugar)
addsugar_bf_main <- lmBF(ADD_SUGARS_ave ~ ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID,
                           whichRandom = c('WINS.ID'), data = df_long_add_sugar)
addsugar_bf_int/addsugar_bf_main
## Bayes factor analysis
## --------------
## [1] ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + Treatment * Time +     WINS.ID : 0.2832552 ±4.05%
## 
## Against denominator:
##   ADD_SUGARS_ave ~ ADD_SUGARS_ave_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment + Time + WINS.ID 
## ---
## Bayes factor type: BFlinearModel, JZS

Bayes Factor here is the ratio of the full model (covariates, treatment, time plus treatment*time interaction) divided by the covariate-only model (covariates, treatment, time): both Bayes factors are between 0.1 and 0.33 and thus there is moderate evidence for the model without the treatment by time interaction.

Bootstrap

In the case that model assumptions may not be satisfied for all models, we performed a non-parametric median bootstrap method described by Wilcox (Wilcox 2023). Note that these analyses don’t include covariates so may not be as powerful as the ANCOVA or LMM.

# Adapted from WINS_Sensitivity_Bootstrap_2024-03-06.R Code:
# Thank you to Xiwei Chen for this analysis!

library(openxlsx)
library(dplyr)
library(janitor)
library(stringr)
library(kableExtra)
library(foreach); library(doParallel)

`%notin%` <- Negate(`%in%`)

###############
## Load Data ##
###############

imputed_long_1 <- read.csv("../Data/11 MI Runs - February/DQ 1 MI/imputed_39_long_by_Trt_DQ1_2024-02-19.csv")
imputed_long_2 <- read.csv("../Data/11 MI Runs - February/DQ 2 MI/imputed_41_long_by_Trt_DQ2_2024-02-20.csv") 
imputed_long_3 <- read.csv("../Data/11 MI Runs - February/WL MI/imputed_38_long_by_Trt_WL_2024-02-20.csv") 
imputed_long_4 <- read.csv("../Data/May MI Runs/Behavioral 1 MI/imputed_35_long_by_Trt_B1_2024-05-26.csv") 
imputed_long_5 <- read.csv("../Data/11 MI Runs - February/Behavioral 2 MI/imputed_57_long_by_Trt_B2_2024-02-20.csv") 
imputed_long_6 <- read.csv("../Data/11 MI Runs - February/Behavioral 3 MI/imputed_187_long_by_Trt_B3_2024-02-20.csv")


###############
## Treatment ##
###############

imputed_long_1$Treatment <- relevel(factor(imputed_long_1$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")
imputed_long_2$Treatment <- relevel(factor(imputed_long_2$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")
imputed_long_3$Treatment <- relevel(factor(imputed_long_3$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")
imputed_long_4$Treatment <- relevel(factor(imputed_long_4$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")
imputed_long_5$Treatment <- relevel(factor(imputed_long_5$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")
imputed_long_6$Treatment <- relevel(factor(imputed_long_6$Treatment, levels = c(1,2), labels = c("Weight Watchers", "Control")), ref = "Weight Watchers")


##############
## Outcomes ##
##############

yvars_1 = colnames(imputed_long_1 %>% select(ends_with("_change")))
yvars_2 = colnames(imputed_long_2 %>% select(ends_with("_change")))
yvars_3 = colnames(imputed_long_3 %>% select(ends_with("_change"),"changekg_percent_body_wt"))
yvars_4 = colnames(imputed_long_4 %>% select(ends_with("_change")))
yvars_5 = colnames(imputed_long_5 %>% select(ends_with("_change")))
yvars_6 = colnames(imputed_long_6 %>% select(ends_with("_change")))


###############
## Bootstrap ##
###############

# Setup parallel backend to use many processors
# cores = detectCores()
cl = makeCluster(28) ##not to overload your computer cores[1]-1
registerDoParallel(cl)

result_1 = 
  foreach(i = 1:length(unique(imputed_long_1$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_1 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_1), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

result_2 = 
  foreach(i = 1:length(unique(imputed_long_2$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_2 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_2), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

result_3 = 
  foreach(i = 1:length(unique(imputed_long_3$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_3 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_3), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

result_4 = 
  foreach(i = 1:length(unique(imputed_long_4$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_4 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_4), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

result_5 = 
  foreach(i = 1:length(unique(imputed_long_5$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_5 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_5), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

result_6 = 
  foreach(i = 1:length(unique(imputed_long_6$.imp)), .errorhandling = "remove", .combine='rbind') %dopar% {
    library(dplyr); library(janitor); library(stringr)
    
    set.seed(1234)
    
    imputed_data = imputed_long_6 %>% filter(.imp == i)
    
    OUT.median = NULL
    for (j in 1:10000){
      id_boot_trt = sample(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"]), 
                           length(unique(imputed_data[imputed_data$Treatment == "Weight Watchers", "WINS.ID"])), 
                           replace = TRUE)
      id_boot_ctrl = sample(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"]), 
                            length(unique(imputed_data[imputed_data$Treatment == "Control", "WINS.ID"])), 
                            replace = TRUE)
      id_boot = data.frame(WINS.ID = c(id_boot_trt, id_boot_ctrl))
      df = merge(id_boot, imputed_data, by = "WINS.ID")
      
      out = df %>%
        group_by(Treatment) %>%
        summarise_at(vars(yvars_6), median, na.rm = TRUE) %>%
        t %>% ##Transpose
        as.data.frame() %>% 
        row_to_names(1) %>% ##First row to be column name
        mutate_at(c("Weight Watchers", "Control"), as.numeric) %>%
        mutate(Outcome = row.names(.), 
               Diff = `Weight Watchers` - Control,
               iter = j) %>%
        select(iter, Outcome, `Weight Watchers`, Control, Diff)
      OUT.median = rbind(OUT.median, out)
    }
    
    out = OUT.median %>%
      group_by(Outcome) %>%
      summarise_at(vars(c("Weight Watchers", "Control", "Diff")), list(mean = mean, sd = sd), na.rm = TRUE) %>%
      mutate(.imp = i) %>%
      select(.imp, Outcome, `Weight Watchers_mean`, `Weight Watchers_sd`, Control_mean, Control_sd, Diff_mean, Diff_sd)
    
    out
  }

# Stop cluster
stopCluster(cl)


# Save output
result = rbind(result_1,result_2,result_3,result_4,result_5,result_6) %>% arrange(Outcome, .imp)
write.csv(result, "../Output/WINS_Sensitivity_Bootstrap_2024-03-06.csv", row.names = FALSE)
# WINS_Sensitivity_Bootstrap_Tables Code:

###############
## Load Data ##
###############

bootstrap_df <- read.csv("../Output/WINS_Sensitivity_Bootstrap_2024-06-07.csv")


#######################
## Homemade Function ##
#######################

Mult_Imp_Template <- function(Means, SEs, m){
  Group <- data.frame(Imputation = 1:m,
                              Mean = Means,
                              SE = SEs)
  Group$Var = Group$SE * Group$SE
  
  mean_Qbar = colMeans(Group[,-1])
  
  variance_B = c(var(Group$Mean), sqrt(var(Group$Mean)))
  
  total_var_T = mean_Qbar[3] + (1+(1/m)) * variance_B[1]
  
  SE_sqrtT = sqrt(total_var_T)
  
  test_stat_t = abs(mean_Qbar[1] / sqrt(total_var_T))
  
  df = (m-1)*(1+(m*mean_Qbar[3])/((m+1)*variance_B[1]))^2
  
  p.value = pt(-abs(test_stat_t), df)*2
  
  tab <- data.frame(Imputation = c(1:m, "mean (Qbar)", "", "variance (B)", "m=", 
                                   "Total Var (T)", "SE = sqrt(T)", "test stat (t)",
                                   "df", "", "p-value"),
                    Mean = c(Means, 
                             round(mean_Qbar[1], 2), "", round(variance_B[1],2), m, 
                             round(total_var_T, 2), 
                             round(SE_sqrtT, 2), 
                             round(test_stat_t, 2), 
                             round(df, 2), "", 
                             round(p.value, 2)),
                    SE = c(SEs,
                           round(mean_Qbar[2], 2),
                           "", round(variance_B[2],2), "", "=Ubar+(1+1/M)*B", 
                           rep("", 5)),
                    Var = c(Group$Var, 
                            round(mean_Qbar[3], 2), "=Ubar", rep("", 8))
  )
return(tab)
}

Mult_Imp_row <- function(Means, SEs, m){
  Group <- data.frame(Imputation = 1:m,
                              Mean = Means,
                              SE = SEs)
  Group$Var = Group$SE * Group$SE
  
  mean_Qbar = colMeans(Group[,-1])
  
  variance_B = c(var(Group$Mean), sqrt(var(Group$Mean)))
  
  total_var_T = mean_Qbar[3] + (1+(1/m)) * variance_B[1]
  
  SE_sqrtT = sqrt(total_var_T)
  
  test_stat_t = abs(mean_Qbar[1] / sqrt(total_var_T))
  names(test_stat_t) <- "test_stat_t"
  
  df = (m-1)*(1+(m*mean_Qbar[3])/((m+1)*variance_B[1]))^2
  names(df) <- "df"
  
  p.value = pt(-abs(test_stat_t), df)*2
  names(p.value) <- "p_value"
  
  row <- c(mean_Qbar[1:2], test_stat_t, df, p.value)
  
return(row)
}


## different outcomes in main outcome paper vs bootstrap results
#######################################################################
# setdiff(unique(bootstrap_df$Outcome), outcomes)
# setdiff(outcomes, unique(bootstrap_df$Outcome))
# remove 3 acheive from here outcome_pairs
bootstrap_pairs <- outcome_pairs %>% subset(outcomes %in% setdiff(outcome_pairs$outcome, setdiff(outcomes, unique(bootstrap_df$Outcome))))
bootstrap_outcomes <- bootstrap_pairs$outcome
#remove 2 extra from bootstrap_df
bootstrap_df <- bootstrap_df %>% subset(Outcome %in% bootstrap_outcomes)

# indices:
# 1:15, 16:24, 25:30, 31:34, 35:37, 38:52

# make output shell table to save results for each outcome in the analysis loop
cols <- c("Outcome", "Outcome_label", "Mean1", "SE1", "Mean2", "SE2", "Mean_Diff",
          "SE_Diff", "t", "df", "p_value")
output = matrix(nrow = length(bootstrap_outcomes), ncol = length(cols))
colnames(output) = cols

# save unrounded for primary comparison
output_raw <- output

Wilcox median bootstrap method results for outcomes in WINS main outcomes paper, excluding 3 binary percent weight loss achieved outcomes.

Results

# Putting bootstrap results through MI template

for (out in bootstrap_outcomes){
  # Mult_Imp_Template <- function(Means, SEs, m)
  
  data_df <- subset(bootstrap_df, Outcome == out)
  iters <- max(data_df$.imp)
  
  # Treatment Group:
  tab_trt <- formatC(Mult_Imp_row(data_df$Weight.Watchers_mean, data_df$Weight.Watchers_sd, iters)[1:2], digits = 2, format = "f") 
  # round(Mult_Imp_row(data_df$Weight.Watchers_mean, 
  #                    data_df$Weight.Watchers_sd, iters)[1:2],2)
  
  # Control Group:
  tab_control <- formatC(Mult_Imp_row(data_df$Control_mean, data_df$Control_sd, iters)[1:2], digits = 2, format = "f")
    # round(Mult_Imp_row(data_df$Control_mean,
    #                    data_df$Control_sd, iters)[1:2],2)
  
  # Difference:
  tab_diff <- Mult_Imp_row(data_df$Diff_mean,
                           data_df$Diff_sd, iters)
  tab_diff[1:4] <- formatC(tab_diff[1:4], digits = 2, format = "f") #round(tab_diff[1:4], 2)
  tab_diff[5] <- case_when(as.numeric(tab_diff[5]) < 0.001 ~ format.pval(as.numeric(tab_diff[5]), eps = 0.001, digits = 3, nsmall=3),
                        TRUE ~ formatC(as.numeric(tab_diff[5]), digits = 3, format = "f"))
    #round(tab_diff[5], 3)
  
  index = which(out == bootstrap_pairs$outcome)
  output[index, 1] = bootstrap_pairs[which(out == bootstrap_pairs$outcome),1]
  output[index, 2] = bootstrap_pairs[which(out == bootstrap_pairs$outcome),2]
  output[index, 3:4] = c(tab_trt)
  output[index, 5:6] = tab_control
  output[index, 7:11] = tab_diff
  
  output_raw[index, 1] = bootstrap_pairs[which(out == bootstrap_pairs$outcome),1]
  output_raw[index, 2] = bootstrap_pairs[which(out == bootstrap_pairs$outcome),2]
  output_raw[index, 3:4] = c(Mult_Imp_row(data_df$Weight.Watchers_mean, data_df$Weight.Watchers_sd, iters)[1:2])
  output_raw[index, 5:6] = c(Mult_Imp_row(data_df$Control_mean, data_df$Control_sd, iters)[1:2])
  output_raw[index, 7:11] =  Mult_Imp_row(data_df$Diff_mean, data_df$Diff_sd, iters)
}

# for comparison tables later
output_bootstrap <- output_raw
output_bootstrap <- as.data.frame(output_bootstrap)

kable(output, col.names = c("Variable", "Outcome Label", "Mean", "SE", "Mean", "SE", "Mean", "SE", "t", "df", "p-value")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2, "Weight Watchers" = 2,  "Control" = 2, "Difference" = 2, "Model Statistics" = 3)) %>%
    pack_rows(index = c("Change ASA24 in HEI Diet Quality Scores" = 14,
                      "Other Dietary Quality Measures" = 1,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6-3,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15))
Weight Watchers
Control
Difference
Model Statistics
Variable Outcome Label Mean SE Mean SE Mean SE t df p-value
Change ASA24 in HEI Diet Quality Scores
HEI2015_TOTAL_SCORE_change HEI Total Score 4.30 1.36 0.25 0.95 4.05 1.66 2.35 8214.12 0.019
HEI2015C1_TOTALVEG_change Total Vegetable 0.01 0.04 0.00 0.01 0.01 0.04 0.20 60198.55 0.840
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 0.01 0.05 0.00 0.00 0.01 0.05 0.10 145283.07 0.919
HEI2015C3_TOTALFRUIT_change Total Fruit 0.24 0.16 -0.00 0.03 0.24 0.16 1.38 2299.14 0.167
HEI2015C4_WHOLEFRUIT_change Whole Fruit 0.00 0.01 -0.00 0.01 0.00 0.01 0.11 4113267.16 0.911
HEI2015C5_WHOLEGRAIN_change Whole Grains 0.05 0.11 0.03 0.09 0.02 0.14 0.14 18354.06 0.890
HEI2015C6_TOTALDAIRY_change Total Dairy -0.40 0.24 0.15 0.23 -0.55 0.34 1.59 11380.63 0.112
HEI2015C7_TOTPROT_change Total Protein Foods 0.00 0.00 0.00 0.00 0.00 0.00 NaN NaN NaN
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins -0.00 0.00 0.00 0.00 -0.00 0.00 0.01 386723497.06 0.996
HEI2015C9_FATTYACID_change Fatty Acids 0.55 0.40 0.08 0.20 0.47 0.45 0.98 3104.20 0.327
HEI2015C10_SODIUM_change Sodium -0.39 0.35 -0.54 0.28 0.15 0.45 0.31 6661.70 0.756
HEI2015C11_REFINEDGRAIN_change Refined Grains 0.35 0.30 -0.12 0.20 0.47 0.36 1.25 5655.44 0.212
HEI2015C12_SFAT_change Saturated Fats 0.84 0.35 0.26 0.28 0.58 0.45 1.23 8402.30 0.219
HEI2015C13_ADDSUG_change Added Sugars 0.22 0.18 0.09 0.12 0.13 0.22 0.57 10507.19 0.568
Other Dietary Quality Measures
amed_change AMED Score 0.08 0.54 -0.32 0.56 0.40 0.79 0.49 14163.36 0.625
Change in Micro and Macro Nutrients
KCAL_ave_change Average Total Energy -372.11 57.56 -220.79 45.19 -151.32 73.67 1.95 4274.00 0.051
TFAT_ave_change Average Total Fat -19.70 2.83 -10.38 2.66 -9.32 3.91 2.30 8477.02 0.021
CARB_ave_change Average Total Carbohydrates -50.01 5.07 -22.99 3.84 -27.02 6.40 4.06 8567.76 <0.001
SODI_ave_change Average Sodium -473.12 75.47 -302.29 96.15 -170.83 123.71 1.33 7619.30 0.185
SFAT_ave_change Average Saturated Fats -6.89 0.83 -4.20 0.94 -2.69 1.26 2.07 9265.06 0.039
SUGR_ave_change Average Total Sugars -16.80 2.05 -12.29 3.19 -4.51 3.80 1.16 24909.52 0.246
ADD_SUGARS_ave_change Average Added Sugars -3.98 0.69 -2.33 0.59 -1.65 0.91 1.73 5563.00 0.084
CHOLE_ave_change Average Total Cholesterol -36.75 11.37 -21.08 13.91 -15.67 18.20 0.83 7775.34 0.407
FIBE_ave_change Average Fiber -2.64 0.59 -1.70 0.54 -0.94 0.80 1.12 4751.68 0.264
Weight Loss Measures
weightkg_change Body Weight (kg) -4.31 0.70 -1.19 0.34 -3.12 0.77 3.88 5330.53 <0.001
BMI_change BMI -1.54 0.19 -0.42 0.12 -1.13 0.23 4.76 5481.64 <0.001
changekg_percent_body_wt Percent Body Weight Change -4.78 0.63 -1.28 0.39 -3.50 0.74 4.51 5515.63 <0.001
Change in Physical Activity
METS_change Total Physical Activity MET 186.96 93.09 127.09 98.86 59.87 136.63 0.41 2580.50 0.681
sendentary_change Sedentary -55.74 15.35 -6.35 11.95 -49.39 19.56 2.42 6478.83 0.016
moderate_change Moderate 63.98 56.41 23.37 51.14 40.62 76.50 0.50 2353.17 0.620
vigorous_change Vigorous 0.04 1.79 0.00 0.00 0.04 1.79 0.01 53716147.48 0.991
Change Self-Reported Sleep
sleep_quality_change Sleep Quality -0.03 0.09 0.09 0.15 -0.12 0.17 0.67 67257.07 0.502
sleep_amount_change Usual Sleep Amount -0.00 0.00 0.00 0.00 -0.00 0.00 0.00 6273836315.74 0.998
wake_episodes_change Wake Episodes -0.04 0.10 -0.00 0.03 -0.03 0.10 0.31 21381.56 0.755
Change in Habit Strength
SRBAI_change SRBAI Habit Strength 0.76 0.10 0.26 0.08 0.50 0.13 1.92 318.86 0.056
Avg1_change Considering Portion Sizes 0.72 0.20 0.70 0.17 0.01 0.26 0.05 11902.74 0.964
Avg2_change Tracking Food Consumption 1.09 0.17 0.49 0.19 0.60 0.26 2.19 21457.95 0.029
Avg3_change Consider WW Points 3.73 0.36 0.00 0.00 3.73 0.36 9.71 12065.81 <0.001
Avg4_change Frequency of Eating Vegetables 0.27 0.17 0.11 0.14 0.15 0.23 0.64 18414.26 0.521
Avg5_change Frequency of Weighing Self 0.72 0.22 0.26 0.16 0.45 0.28 0.80 325.21 0.427
Avg6_change Frequency of Physical Activity 0.64 0.18 0.15 0.16 0.50 0.25 0.99 324.39 0.325
Avg7_change Talking Kindly to Self After Setback 0.52 0.22 0.01 0.05 0.51 0.22 1.96 2754.14 0.050
Avg8_change Arranging Healthy Foods for Easy Access 0.70 0.20 0.11 0.19 0.60 0.28 1.99 16364.00 0.047
Avg9_change Frequency of Fried Foods -0.50 0.21 -0.03 0.08 -0.47 0.22 1.94 8928.11 0.052
Avg10_change Frequency of Sweets -1.02 0.14 -0.16 0.14 -0.86 0.20 4.17 29414.15 <0.001
Avg11_change Frequency of Sugary Beverages -0.15 0.14 -0.00 0.00 -0.15 0.14 0.95 11063.23 0.342
Avg12_change Snacking When Not Hungry -0.67 0.16 -0.16 0.14 -0.50 0.22 2.19 13840.94 0.028
UnhSRBAI_change Unhealthy Grouped -0.79 0.14 -0.33 0.08 -0.46 0.16 2.67 13538.54 0.008
healSRBAI_change Healthy Grouped 1.12 0.08 0.56 0.07 0.56 0.10 5.06 18724.22 <0.001

Comparison

Let’s compare results from the Wilcox bootstrap method with the primary:

# merge primary and sensitivity raw p-values:
comparison <- merge(primary_results[,c("Outcome_label", "p_value")], output_raw[,c("Outcome_label", "p_value")], 
                    by = "Outcome_label", suffixes = c(".primary", ".sens"), sort = FALSE)

# make p-values numeric
comparison$p_value.primary = as.numeric(comparison$p_value.primary)
comparison$p_value.sens = as.numeric(comparison$p_value.sens)

comparison <- comparison %>% mutate(
  change = case_when(p_value.primary < 0.05 & p_value.sens < 0.05 ~ "No Change",
                     p_value.primary > 0.05 & p_value.sens > 0.05 ~ "No Change",
                     p_value.primary < 0.05 & p_value.sens > 0.05 ~ "Change",
                     p_value.primary > 0.05 & p_value.sens < 0.05 ~ "Change")
)

table(comparison$change)
## 
##    Change No Change 
##        15        33

Note: one outcome (Total Protein Foods) didn’t have a Bootstrap p-value so it can’t be compared against the Primary analysis.

33 of the 49 outcomes did not change in level of significance between the primary and Wilcox Bootstrap sensitivity analysis.

The 15 outcomes that did result in a level of significant change are as follows:

colnames(comparison) =c("Outcome", "Primary p-value", "Bootstrap p-value", "Change")
comparison[,2:3] = round(comparison[,2:3], 3)

# Display results that changed in significance
comparison.flips <- comparison[which(comparison$Change == "Change"), -4]
comparison.flips$color = 0
comparison.flips$color[comparison.flips$`Primary p-value` < comparison.flips$`Bootstrap p-value`] = 1
rownames(comparison.flips) = NULL
kable(comparison.flips[,-4]) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()  %>%
  row_spec(which(comparison.flips$color >0), color = "red") %>%
  row_spec(which(comparison.flips$color <1), color = "blue")
Outcome Primary p-value Bootstrap p-value
Greens and Beans 0.002 0.919
Total Fruit 0.006 0.167
Whole Fruit 0.018 0.911
Refined Grains 0.002 0.212
Average Total Energy 0.000 0.051
Average Sodium 0.000 0.185
Average Total Sugars 0.047 0.246
Average Added Sugars 0.019 0.084
Sedentary 0.118 0.016
Sleep Quality 0.004 0.502
Usual Sleep Amount 0.014 0.998
Considering Portion Sizes 0.020 0.964
Talking Kindly to Self After Setback 0.140 0.050
Frequency of Sugary Beverages 0.033 0.342
Snacking When Not Hungry 0.200 0.028

Outcomes with standardized residuals from the primary analysis showing skewness <-2 or >2 or ratio of variance <0.67 or >1.5 (using means across imputations) are considered potentially problematic, and the Bootstrap analysis should be considered to better satisfy assumptions. (See Blanca 2018, Casella & Berger 2021, Glass & Hopkins 1996, Glass, Peckham, Sanders 1972).

# of all the outcomes, which ones violated model assumptions for the primary models
violators = as.data.frame(outcomes <- rbind(
  # # Dietary quality
  # # Change in ASA24 HEI Diet Quality Scores (Total and Subscores)  1:14
  # c("HEI2015_TOTAL_SCORE_change",  "HEI Total Score"),
  # c("HEI2015C1_TOTALVEG_change", "Total Vegetable"),
  # c("HEI2015C2_GREEN_AND_BEAN_change",  "Greens and Beans"),
  # c("HEI2015C3_TOTALFRUIT_change","Total Fruit"),
  # c("HEI2015C4_WHOLEFRUIT_change", "Whole Fruit"),
  # c("HEI2015C5_WHOLEGRAIN_change", "Whole Grains"),
  # c("HEI2015C6_TOTALDAIRY_change", "Total Dairy"),
  c("HEI2015C7_TOTPROT_change", "Total Protein Foods", "yes (-2.39)", "no"),
  # c("HEI2015C8_SEAPLANT_PROT_change", "Seafood and Plant Proteins"),
  # c("HEI2015C9_FATTYACID_change", "Fatty Acids"),
  # c("HEI2015C10_SODIUM_change", "Sodium"),
  # c("HEI2015C11_REFINEDGRAIN_change", "Refined Grains"),
  # c("HEI2015C12_SFAT_change","Saturated Fats"),
  # c("HEI2015C13_ADDSUG_change","Added Sugars"),
  # # Other Dietary Quality Measures 15:16
  # c("DIETIDHEI_change", "Diet ID Total Score"),
  # c("amed_change", "AMED Score"),
  # # Change in Average Micro and Macro Nutrients Between Endline and Baseline 17:25
  # c("KCAL_ave_change", "Average Total Energy"),
  # c("TFAT_ave_change", "Average Total Fat"),
  # c("CARB_ave_change", "Average Total Carbohydrates"),
  # c("SODI_ave_change", "Average Sodium"),
  # c("SFAT_ave_change", "Average Saturated Fats"),
  # c("SUGR_ave_change", "Average Total Sugars"),
  # c("ADD_SUGARS_ave_change", "Average Added Sugars"),
  # c("CHOLE_ave_change", "Average Total Cholesterol"),
  # c("FIBE_ave_change", "Average Fiber"),
  # # Weight loss
  # # Weight Loss Measures 26:31
  # c("weightkg_change", "Body Weight (kg)"),
  # c("BMI_change", "BMI"),
  # c("changekg_percent_body_wt", "Percent Body Weight Change"),
  # c("achieve_3_percent_wl", "Achieved 3% Weight Loss"),
  # c("achieve_5_percent_wl", "Achieved 5% Weight Loss"),
  # c("achieve_10_percent_wl","Achieved 10% Weight Loss"),
  # # Behavioral
  # # Change in Physical Activity 32:35
  # c("METS_change","Total Physical Activity MET"),
  # c("sendentary_change", "Sedentary"),
  c("moderate_change", "Moderate", "yes (2.29)", "no"),
  c("vigorous_change", "Vigorous", "yes (3.14)", "no"),
  # # Change in Self Reported Sleep 36:38
  # c("sleep_quality_change", "Sleep Quality"),
  # c("sleep_amount_change",  "Usual Sleep Amount"),
  c("wake_episodes_change","Wake Episodes", "yes (2.21)", "no")
  # # Change in Habit Strength (for each behavior assessed, then grouped healthy and unhealthy) 39:53
  # c("SRBAI_change", "SRBAI Habit Strength"),
  # c("Avg1_change", "Considering Portion Sizes"),
  # c("Avg2_change", "Tracking Food Consumption"),
  # c("Avg3_change", "Consider WW Points"),
  # c("Avg4_change", "Frequency of Eating Vegetables"),
  # c("Avg5_change", "Frequency of Weighting Self"),
  # c("Avg6_change", "Frequency of Physical Activity"),
  # c("Avg7_change", "Talking Kindly to Self After Setback"),
  # c("Avg8_change", "Arranging Healthy Foods for Easy Access"),
  # c("Avg9_change", "Frequency of Fried Foods"),
  # c("Avg10_change", "Frequency of Sweets"),
  # c("Avg11_change", "Frequency of Sugary Beverages"),
  # c("Avg12_change", "Snacking When Not Hungry"),
  # c("UnhSRBAI_change", "Unhealthy Grouped"),
  # c("healSRBAI_change","Healthy Grouped")
))

colnames(violators) = c("Outcomes", "Outcome Labels", "Skewness >2", "Ratio of Variance >1.5")
violators_vec <- violators$Outcomes

kable(violators) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() #%>%
Outcomes Outcome Labels Skewness >2 Ratio of Variance >1.5
HEI2015C7_TOTPROT_change Total Protein Foods yes (-2.39) no
moderate_change Moderate yes (2.29) no
vigorous_change Vigorous yes (3.14) no
wake_episodes_change Wake Episodes yes (2.21) no
 # add_header_above(c(" " = 2,  "Violations" = 2))

Four outcomes (HEI total protein, moderate activity, vigorous activity, and wake episodes) violated primary analysis model assumption criteria (as specified above), but results of significance tests were consistent with the Wilcox median bootstrap method:

comparison_short <- subset(comparison, Outcome %in% violators$`Outcome Labels`)[,-4]

rownames(comparison_short) <- NULL

kable(comparison_short, col.names = c("Outcome Label", "Primary p-value", "Bootstrap p-value")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()
Outcome Label Primary p-value Bootstrap p-value
Total Protein Foods 0.738 NaN
Moderate 0.715 0.620
Vigorous 0.983 0.991
Wake Episodes 0.837 0.755

Looking back at the outcomes that did switch in significance between the primary and bootstrap results, there are none that violated assumptions and switched significance between the primary and bootstrap results.


Dropout

Per an AJCN reviewer’s request, a sensitivity analysis has been added to address differential loss to follow-up between treatment arms. A logistic model was built using baseline data to predict loss to follow-up (based on variables listed in table below). The resulting predicted log-odds were included as a covariate in the main LMM analysis. Results from this adjusted LMM were then compared to the original to assess differences.

Tables

Table of candidate covariates, stratified by follow-up status, for the logistic regression model predicting the likelihood of dropout.

# Using raw_data, saved as data_tab with nice labels.
follow_up_tab <- data_tab


# pull lost to follow up IDs from a larger data set with variables across
# all the data collection platforms (Diet ID, ASA24, and Qualtrics)
# As some variables not in this analysis (Diet ID) have been redacted from this report.
larger_raw_data <- read.csv("../Data/analytic_raw_data_2024-06-07.csv")
# ^ not necessary and sufficient.

# Step 1: Create Follow-up Status Variable
# Pull all endline variables (those ending in _el)
endline_vars <- grep("_el$", names(larger_raw_data), value = TRUE)

# Create follow-up status: if ALL endline vars are NA = "Lost", else = "Completed"
# and followup_status in the table above coded as 0/1:

larger_raw_data <- larger_raw_data %>%
  mutate(dropout = if_else(rowSums(!is.na(across(all_of(endline_vars)))) == 0, 1, 0),
         followup_status = ifelse(rowSums(!is.na(across(all_of(endline_vars)))) == 0,
                                   "Lost to Follow-up", "Completed"))

follow_up_tab <- follow_up_tab %>% left_join(larger_raw_data %>% 
                                               select(WINS.ID, followup_status, dropout),
                                             by = "WINS.ID") %>%
  # remove duplicates
  select(-c(Race_bcf, Income_bcf, Education_bcf, weight_bl)) 
# check results match consort diagram numbers
# table(follow_up_tab$followup_status)

# Step 2: Create a Combined Grouping Variable
# Create combined group ("Arm_Completed", "Arm_Lost to Follow-up")
follow_up_tab$group <- paste(follow_up_tab$Treatment, follow_up_tab$followup_status, sep = "_")

# Step 3: Select Baseline Variables
# Pull all relevant baseline variables
baseline_vars_all <- grep("^Age_years$|^Sex_bcf$|^Gender_grouped$|^Race|^Ethnicity|^Income|^Education|^foodinsec|_bl$", 
                      names(follow_up_tab), value = TRUE)

# 3b: Define your desired demographic order explicitly
demographic_vars <- c("Age_years", "Sex_bcf", "Gender_grouped", 
                      "Race2_bcf", "Ethnicity_bcf", "Income_grouped",
                      "foodinsec", "Education_grouped")

# Identify the remaining outcome vars (those ending in _bl, but not demographics)
outcome_vars <- setdiff(baseline_vars_all, c(demographic_vars, "amed_bl", "weight_bl"))

# Combine in your desired order
baseline_vars <- c(demographic_vars, outcome_vars)

# Subset data to relevant variables
follow_up_tab <- follow_up_tab[, c("group", baseline_vars, "followup_status", "dropout", "Treatment", "WINS.ID")]

# Pull outcome labels:
outcome_labels <- outcome_pairs
outcome_labels$outcome <- gsub("_change$", "_bl", outcome_labels$outcome)
# add extra:
new_labels <- data.frame(
  outcome = c("Gender_grouped", "Race2_bcf", "Ethnicity_bcf", 
              "Income_grouped", "Education_grouped", "foodinsec", "group"),
  outcome_labels = c("Gender", "Race", "Hispanic, Latinx, or Spanish",
                     "Household Income, USD", "Highest level of education", 
                     "Food insecurity",  "Follow-up Status"),
  stringsAsFactors = FALSE
)

# Append the new labels to the existing outcome_labels data frame
outcome_labels <- rbind(outcome_labels, new_labels)
# Create named list for rename
label_list <- as.list(setNames(outcome_labels$outcome_labels, outcome_labels$outcome))


# rename column headers:
follow_up_tab$group <- factor(follow_up_tab$group, 
                             levels = c("Weight Watchers_Completed",
                                        "Weight Watchers_Lost to Follow-up",
                                        "Control_Completed",
                                        "Control_Lost to Follow-up"),
                             labels = c(
                               "Weight Watchers - Completed",
                               "Weight Watchers - Lost to Follow-up",
                               "Control - Completed",
                               "Control - Lost to Follow-up"
                             ))

Demographics

 follow_up_tab %>%
  select(all_of(demographic_vars), followup_status) %>%
  tbl_summary(by = followup_status,
              #missing = "no",
              statistic = list(all_continuous() ~ "{mean} ({sd})",
                               all_categorical() ~ "{n} ({p}%)"),
              digits = list(Age_years = c(0, 1)),
              percent = "row",
              label = label_list,
              type = all_dichotomous() ~ "categorical") %>%
  add_overall(last = TRUE) %>%
  modify_header(label = "**Baseline Demographics**") %>%
  bold_labels()
Baseline Demographics Completed
N = 346
1
Lost to Follow-up
N = 30
1
Overall
N = 376
1
Age, years 48 (12.1) 43 (13.2) 48 (12.2)
Sex assigned at birth


    Female 270 (91%) 28 (9.4%) 298 (100%)
    Male 76 (97%) 2 (2.6%) 78 (100%)
Gender


    Female 267 (91%) 26 (8.9%) 293 (100%)
    Male 77 (96%) 3 (3.8%) 80 (100%)
    Non-binary / third gender / Transgender 2 (67%) 1 (33%) 3 (100%)
Race


    Asian 22 (79%) 6 (21%) 28 (100%)
    Black or African-American 49 (94%) 3 (5.8%) 52 (100%)
    White 253 (93%) 19 (7.0%) 272 (100%)
    Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say 22 (92%) 2 (8.3%) 24 (100%)
Hispanic, Latinx, or Spanish


    No 311 (91%) 29 (8.5%) 340 (100%)
    Yes 35 (97%) 1 (2.8%) 36 (100%)
Household Income, USD


     $59,999 or under 92 (93%) 7 (7.1%) 99 (100%)
    Between $60,000 and $99,999 115 (93%) 8 (6.5%) 123 (100%)
    $100,000 or above 139 (90%) 15 (9.7%) 154 (100%)
Food insecurity


    No 260 (100%) 0 (0%) 260 (100%)
    Yes 67 (100%) 0 (0%) 67 (100%)
    Unknown 19 30 49
Highest level of education


    Associate degree or below 107 (92%) 9 (7.8%) 116 (100%)
    Bachelor’s degree and some graduate school 119 (89%) 14 (11%) 133 (100%)
    Masters or above 120 (94%) 7 (5.5%) 127 (100%)
1 Mean (SD); n (%)

Outcomes

follow_up_tab %>%
  select(all_of(outcome_vars), followup_status) %>%
  tbl_summary(by = followup_status, 
              #missing = "no", 
              statistic = list(all_continuous() ~ "{mean} ({sd})",
                               all_categorical() ~ "{n} ({p}%)"),
              type = list(sleep_amount_bl ~ "continuous"),
              digits = list(everything() ~ c(1)),
              label = label_list) %>%
  add_overall(last = TRUE) %>%
  modify_header(label = "**Baseline Outcomes**") %>%
  bold_labels()
Baseline Outcomes Completed
N = 346
1
Lost to Follow-up
N = 30
1
Overall
N = 376
1
HEI Total Score 55.3 (12.4) 54.9 (11.7) 55.3 (12.3)
Total Vegetable 3.7 (1.3) 3.7 (1.2) 3.7 (1.3)
Greens and Beans 3.0 (2.0) 3.4 (1.7) 3.0 (2.0)
Total Fruit 2.0 (1.8) 2.0 (2.0) 2.0 (1.8)
Whole Fruit 2.6 (2.1) 2.5 (2.0) 2.6 (2.1)
Whole Grains 3.1 (3.1) 2.5 (2.6) 3.0 (3.1)
Total Dairy 5.5 (2.8) 5.1 (2.6) 5.5 (2.8)
Total Protein Foods 4.7 (0.8) 4.6 (0.9) 4.7 (0.8)
Seafood and Plant Proteins 3.5 (1.9) 3.6 (2.0) 3.5 (1.9)
Fatty Acids 4.7 (3.2) 5.3 (3.3) 4.8 (3.2)
Sodium 3.2 (2.8) 2.5 (2.5) 3.1 (2.8)
Refined Grains 6.8 (3.0) 6.7 (2.9) 6.8 (2.9)
Saturated Fats 4.1 (3.1) 4.9 (3.2) 4.2 (3.1)
Added Sugars 8.2 (2.2) 7.9 (2.7) 8.2 (2.2)
Average Total Energy 2,012.5 (674.0) 1,814.0 (667.2) 1,996.6 (674.7)
Average Total Fat 88.4 (33.8) 76.1 (29.1) 87.4 (33.6)
Average Total Carbohydrates 212.7 (82.9) 201.0 (94.2) 211.8 (83.7)
Average Sodium 3,517.8 (1,282.0) 3,239.3 (1,097.6) 3,495.5 (1,269.2)
Average Saturated Fats 29.0 (12.2) 24.6 (11.2) 28.6 (12.2)
Average Total Sugars 81.7 (41.7) 79.7 (51.1) 81.6 (42.4)
Average Added Sugars 12.0 (8.3) 12.3 (10.4) 12.1 (8.5)
Average Total Cholesterol 334.1 (185.4) 303.9 (137.2) 331.7 (182.0)
Average Fiber 17.8 (8.4) 15.1 (5.8) 17.6 (8.2)
Body Weight (kg) 95.3 (17.2) 88.7 (13.4) 94.8 (17.0)
    Unknown 1 0 1
BMI 33.7 (4.7) 33.0 (4.3) 33.6 (4.7)
    Unknown 1 0 1
Total Physical Activity MET 1,806.4 (2,771.2) 1,268.0 (1,624.5) 1,763.4 (2,700.1)
Sedentary 492.8 (223.4) 507.3 (292.3) 494.0 (229.2)
Moderate 1,097.0 (1,790.8) 869.3 (1,331.9) 1,078.8 (1,758.2)
Vigorous 709.4 (1,760.0) 398.7 (824.1) 684.6 (1,705.7)
Sleep Quality 2.4 (0.7) 2.4 (0.8) 2.4 (0.7)
Usual Sleep Amount 2.0 (0.3) 2.0 (0.3) 2.0 (0.3)
Wake Episodes 1.3 (1.2) 1.3 (1.0) 1.3 (1.1)
SRBAI Habit Strength 3.3 (0.9) 3.2 (0.9) 3.3 (0.9)
Considering Portion Sizes 3.8 (1.8) 3.4 (1.9) 3.8 (1.8)
Tracking Food Consumption 2.0 (1.7) 2.0 (1.5) 2.0 (1.6)
Consider WW Points 0.7 (1.4) 0.4 (1.1) 0.6 (1.4)
Frequency of Eating Vegetables 4.8 (1.7) 4.8 (1.7) 4.8 (1.7)
Frequency of Weighing Self 3.3 (2.1) 3.0 (1.8) 3.3 (2.1)
Frequency of Physical Activity 3.6 (1.7) 3.5 (1.8) 3.6 (1.7)
Talking Kindly to Self After Setback 3.2 (2.0) 3.3 (1.9) 3.2 (2.0)
Arranging Healthy Foods for Easy Access 3.2 (2.2) 3.0 (2.4) 3.1 (2.2)
Frequency of Fried Foods 3.4 (1.9) 3.7 (2.0) 3.4 (1.9)
Frequency of Sweets 4.5 (1.8) 4.8 (2.1) 4.5 (1.8)
Frequency of Sugary Beverages 2.4 (2.3) 3.0 (2.5) 2.5 (2.3)
Snacking When Not Hungry 4.6 (1.9) 4.4 (1.8) 4.6 (1.9)
Unhealthy Grouped 3.7 (1.4) 3.9 (1.4) 3.7 (1.4)
Healthy Grouped 3.1 (1.0) 2.9 (1.0) 3.1 (1.0)
1 Mean (SD)

Logistic

Univariable

Unadjusted model results for all baseline demographic and outcome measures, excluding the four binary weight loss variables, with one model per variable (\(dropout = variable\)).

follow_up_data <- follow_up_tab %>%
  # redo levels so they'll appear in table
  mutate(Race2_bcf = case_when(Race2_bcf == "Black or African-American" ~ "Black",
                               Race2_bcf == "Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say" ~ "Other", 
                               TRUE ~ Race2_bcf),
         Treatment = case_when(Treatment == "Weight Watchers" ~ "WW", 
                               TRUE ~ Treatment),
         Income_grouped = case_when(Income_grouped == " $59,999 or under" ~ "Low",
                                    Income_grouped == "Between $60,000 and $99,999" ~ "Medium",
                                    Income_grouped == "$100,000 or above" ~ "High"), 
         Education_grouped = case_when(Education_grouped == "Associate degree or below" ~ "Low",
                                       Education_grouped == "Bachelor’s degree and some graduate school" ~ "Medium",
                                       Education_grouped == "Masters or above" ~ "High")
         
  ) %>%
  select(all_of(demographic_vars), all_of(outcome_vars), Treatment, dropout, "WINS.ID")


t_unadjusted <- 
  tbl_uvregression(
    method = glm,
    y = dropout,
    data = follow_up_data %>% select(-c("WINS.ID")),
    method.args = list(family = binomial),
    exponentiate = TRUE, 
    pvalue_fun = ~ style_pvalue(.x, digits = 3), 
    estimate_fun =  ~ style_number(.x, digits = 2),
    label = label_list
  ) 

t_unadjusted %>%
  add_global_p() %>% 
  modify_table_styling(
    column = estimate, 
    rows = !is.na(estimate),
    cols_merge_pattern = "{estimate} ({conf.low})",
    label = "**Estimate (95% CI)**"
  )
Characteristic N Estimate (95% CI) p-value
Age, years 376 0.97 (0.94) 0.023
Sex assigned at birth 376
0.026
    Female

    Male
0.25 (0.04)
Gender 376
0.118
    Female

    Male
0.40 (0.09)
    Non-binary / third gender / Transgender
5.13 (0.23)
Race 376
0.129
    Asian

    Black
0.22 (0.04)
    Other
0.33 (0.05)
    White
0.28 (0.10)
Hispanic, Latinx, or Spanish 376
0.171
    No

    Yes
0.31 (0.02)
Household Income, USD 376
0.573
    High

    Low
0.71 (0.26)
    Medium
0.64 (0.25)
Food insecurity 327
>0.999
    No

    Yes
1.00 (0.00)
Highest level of education 376
0.324
    High

    Low
1.44 (0.52)
    Medium
2.02 (0.81)
HEI Total Score 376 1.00 (0.97) 0.855
Total Vegetable 376 0.96 (0.73) 0.776
Greens and Beans 376 1.12 (0.93) 0.238
Total Fruit 376 1.00 (0.80) 0.969
Whole Fruit 376 0.97 (0.81) 0.743
Whole Grains 376 0.94 (0.82) 0.345
Total Dairy 376 0.95 (0.83) 0.442
Total Protein Foods 376 0.89 (0.61) 0.623
Seafood and Plant Proteins 376 1.03 (0.85) 0.765
Fatty Acids 376 1.05 (0.94) 0.390
Sodium 376 0.92 (0.79) 0.221
Refined Grains 376 0.99 (0.88) 0.885
Saturated Fats 376 1.09 (0.96) 0.182
Added Sugars 376 0.94 (0.81) 0.446
Average Total Energy 376 1.00 (1.00) 0.108
Average Total Fat 376 0.99 (0.97) 0.043
Average Total Carbohydrates 376 1.00 (0.99) 0.452
Average Sodium 376 1.00 (1.00) 0.233
Average Saturated Fats 376 0.97 (0.93) 0.044
Average Total Sugars 376 1.00 (0.99) 0.804
Average Added Sugars 376 1.00 (0.96) 0.860
Average Total Cholesterol 376 1.00 (1.00) 0.368
Average Fiber 376 0.95 (0.90) 0.061
Body Weight (kg) 375 0.97 (0.95) 0.032
BMI 375 0.97 (0.89) 0.426
Total Physical Activity MET 376 1.00 (1.00) 0.242
Sedentary 376 1.00 (1.00) 0.741
Moderate 376 1.00 (1.00) 0.464
Vigorous 376 1.00 (1.00) 0.241
Sleep Quality 376 0.95 (0.56) 0.828
Usual Sleep Amount 376 0.50 (0.16) 0.245
Wake Episodes 376 0.96 (0.67) 0.795
SRBAI Habit Strength 376 0.83 (0.53) 0.407
Considering Portion Sizes 376 0.89 (0.73) 0.286
Tracking Food Consumption 376 0.99 (0.78) 0.908
Consider WW Points 376 0.85 (0.57) 0.323
Frequency of Eating Vegetables 376 0.99 (0.80) 0.914
Frequency of Weighing Self 376 0.92 (0.76) 0.346
Frequency of Physical Activity 376 0.96 (0.77) 0.722
Talking Kindly to Self After Setback 376 1.02 (0.84) 0.847
Arranging Healthy Foods for Easy Access 376 0.97 (0.82) 0.680
Frequency of Fried Foods 376 1.06 (0.87) 0.538
Frequency of Sweets 376 1.09 (0.89) 0.424
Frequency of Sugary Beverages 376 1.11 (0.95) 0.189
Snacking When Not Hungry 376 0.94 (0.78) 0.541
Unhealthy Grouped 376 1.12 (0.85) 0.405
Healthy Grouped 376 0.85 (0.58) 0.405
Treatment 376
<0.001
    Control

    WW
5.68 (2.30)
Abbreviations: CI = Confidence Interval, OR = Odds Ratio


Note: The model for food insecurity does not converge, because there are no instances of food insecurity in the loss to follow-up group, with quite a bit of missingness.


Next step is the Multivariable tab.



Multivariable

For multivariable model building, forward stepwise selection was applied to a binary logistic regression model (dropout = 1 vs. 0), starting with the most significant variable from the univariable models (treatment). Additional variables were sequentially added based on significance until all included predictors were significant and no further variables met the inclusion criterion (p < 0.1). The resulting logistic model was then used to generate predicted log-odds, which served as a covariate in the subsequent linear mixed model (LMM) analysis.

Forward selection step 1 (only showing most significant set of model results):

\[Dropout = Treatment + Variable\]

# Forward selection setup:

# setup variables:
# save as a new vector so selected variables can be removed from future candidate selections:
candidate.variables <- baseline_vars

# setup model equation:
baseform <- "dropout ~ Treatment"

# vector for pvalues to be saved:
v1 <- c()


# Forward selection step 1:
# forward selection loop across all candidate variables for selection of second variable:
for (var in candidate.variables) {

  df.temp <- filter(follow_up_data, !is.na(follow_up_data[[var]]))

  # Reduced model: base (Treatment only)
  m.reduced <- glm(as.formula(baseform),
                  data = df.temp, 
                  family = binomial(link = "logit"))
  
  # Full model: base + candidate variable  
  m.full <-glm(formula = as.formula(
      paste(baseform,
            var, sep = " + ")),
                  data = df.temp, 
      family = binomial(link = "logit"))

    # Likelihood ratio test
  test <- anova(m.reduced, m.full, test = "LRT")
  p_val <- test$`Pr(>Chi)`[2]  # p-value for added variable
  
  v1 <- c(v1, p_val)
  
}

# Combine into data frame
forward_results <- data.frame(variable = candidate.variables, p_value = v1)

# View top candidates
forward_results <- forward_results %>% arrange(p_value) 

kableExtra::kbl(forward_results[1:5,], col.names = c("Candidate Variable", "P value")) %>% 
  kable_minimal() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) 
Candidate Variable P value
Age_years 0.0222848
Sex_bcf 0.0265267
weightkg_bl 0.0324502
FIBE_ave_bl 0.0594897
SFAT_ave_bl 0.0710058
selected.var.1 <- head(forward_results, 1)$variable # this is the selected variable

# remove selected variable from list of candidate variables for next step
candidate.variables <- setdiff(candidate.variables, selected.var.1)

# Update complete case data
follow_up_data <- follow_up_data[complete.cases(follow_up_data[,c("dropout",
                                                                  "Treatment",
                                                                  selected.var.1)]),]

# setup model equation:
baseform <- paste("dropout ~ Treatment", selected.var.1, sep = " + ")

Since Age_years has the the smallest p-value overall, let’s add it to the model and proceed.

The model equation is now: dropout ~ Treatment + Age_years


Forward selection step 2 (only showing most significant set of model results):

\[Dropout = Treatment + Age + Variable\]

# Forward selection step 2 :

# vector for pvalues to be saved:
v1 <- c()

# forward selection loop across all candidate variables for selection of second variable:
for (var in candidate.variables) {

  df.temp <- filter(follow_up_data, !is.na(follow_up_data[[var]]))

  # Reduced model: base (Treatment only)
  m.reduced <- glm(as.formula(baseform),
                  data = df.temp, 
                  family = binomial(link = "logit"))
  
  # Full model: base + candidate variable  
  m.full <-glm(formula = as.formula(
      paste(baseform,
            var, sep = " + ")),
                  data = df.temp, 
      family = binomial(link = "logit"))

    # Likelihood ratio test
  test <- anova(m.reduced, m.full, test = "LRT")
  p_val <- test$`Pr(>Chi)`[2]  # p-value for added variable
  
  v1 <- c(v1, p_val)
  
}

# Combine into data frame
forward_results <- data.frame(variable = candidate.variables, p_value = v1)

# View top candidates
forward_results <- forward_results %>% arrange(p_value) 

kableExtra::kbl(forward_results[1:5,], col.names = c("Candidate Variable", "P value")) %>% 
  kable_minimal() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) 
Candidate Variable P value
Sex_bcf 0.0112346
weightkg_bl 0.0271972
SFAT_ave_bl 0.0404136
TFAT_ave_bl 0.0492595
Gender_grouped 0.0962221
selected.var.2 <- head(forward_results, 1)$variable # this is the selected variable

# remove selected variable from list of candidate variables
candidate.variables <- setdiff(candidate.variables, selected.var.2)

# Update complete case data
follow_up_data <- follow_up_data[complete.cases(follow_up_data[,c("dropout",
                                                                  "Treatment",
                                                                  selected.var.1,
                                                                  selected.var.2)]),]

# setup model equation:
baseform <- paste("dropout ~ Treatment", selected.var.1,
                  selected.var.2, sep = " + ")

Since Sex_bcf has the the smallest p-value overall, let’s add it to the model and proceed.

The model equation is now: dropout ~ Treatment + Age_years + Sex_bcf


Forward selection step 3 (only showing most significant set of model results):

\[Dropout = Treatment + Age + Sex + Variable\]

# Forward selection step 3:

# vector for pvalues to be saved:
v1 <- c()

# forward selection loop across all candidate variables for selection of second variable:
for (var in candidate.variables) {

  df.temp <- filter(follow_up_data, !is.na(follow_up_data[[var]]))

  # Reduced model: base (Treatment only)
  m.reduced <- glm(as.formula(baseform),
                  data = df.temp, 
                  family = binomial(link = "logit"))
  
  # Full model: base + candidate variable  
  m.full <-glm(formula = as.formula(
      paste(baseform,
            var, sep = " + ")),
                  data = df.temp, 
      family = binomial(link = "logit"))

    # Likelihood ratio test
  test <- anova(m.reduced, m.full, test = "LRT")
  p_val <- test$`Pr(>Chi)`[2]  # p-value for added variable
  
  v1 <- c(v1, p_val)
  
}

# Combine into data frame
forward_results <- data.frame(variable = candidate.variables, p_value = v1)

# View top candidates
forward_results <- forward_results %>% arrange(p_value) 

kableExtra::kbl(forward_results[1:5,], col.names = c("Candidate Variable", "P value")) %>% 
  kable_minimal() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) 
Candidate Variable P value
SFAT_ave_bl 0.0808730
TFAT_ave_bl 0.0962716
weightkg_bl 0.1361125
FIBE_ave_bl 0.1409521
Race2_bcf 0.1946293
selected.var.3 <- head(forward_results, 1)$variable # this is the selected variable

# remove previously selected variable from list of candidate variables
candidate.variables <- setdiff(candidate.variables, selected.var.3)

# Update complete case data
follow_up_data <- follow_up_data[complete.cases(follow_up_data[,c("dropout",
                                                                  "Treatment",
                                                                  selected.var.1,
                                                                  selected.var.2,
                                                                  selected.var.3)]),]

# setup model equation:
baseform <- paste("dropout ~ Treatment", selected.var.1,
                  selected.var.2, selected.var.3, sep = " + ")

Since SFAT_ave_bl has the the smallest p-value overall, let’s add it to the model and proceed.

The model equation is now: dropout ~ Treatment + Age_years + Sex_bcf + SFAT_ave_bl


Forward selection step 4 (only showing most significant set of model results):

\[Dropout = Treatment + Age + Sex + Average \space Saturated \space Fats + Variable\]

# Forward selection step 4:

# vector for pvalues to be saved:
v1 <- c()

# forward selection loop across all candidate variables for selection of second variable:
for (var in candidate.variables) {

  df.temp <- filter(follow_up_data, !is.na(follow_up_data[[var]]))

  # Reduced model: base (Treatment only)
  m.reduced <- glm(as.formula(baseform),
                  data = df.temp, 
                  family = binomial(link = "logit"))
  
  # Full model: base + candidate variable  
  m.full <-glm(formula = as.formula(
      paste(baseform,
            var, sep = " + ")),
                  data = df.temp, 
      family = binomial(link = "logit"))

    # Likelihood ratio test
  test <- anova(m.reduced, m.full, test = "LRT")
  p_val <- test$`Pr(>Chi)`[2]  # p-value for added variable
  
  v1 <- c(v1, p_val)
  
}

# Combine into data frame
forward_results <- data.frame(variable = candidate.variables, p_value = v1)

# View top candidates
forward_results <- forward_results %>% arrange(p_value) 

kableExtra::kbl(forward_results[1:5,], col.names = c("Candidate Variable", "P value")) %>% 
  kable_minimal() %>%
  kable_styling(bootstrap_options = "striped", full_width = F) 
Candidate Variable P value
vigorous_bl 0.1539703
METS_bl 0.1646769
weightkg_bl 0.1961400
ADD_SUGARS_ave_bl 0.2030041
Race2_bcf 0.2161010
selected.var.4 <- head(forward_results, 1)$variable # this is the selected variable

# variables no longer statistically significant and worthwhile for the model
# # remove previously selected variable from list of candidate variables
# candidate.variables <- setdiff(candidate.variables, selected.var.4)
# 
# # Update complete case data
# follow_up_data <- follow_up_data[complete.cases(follow_up_data[,c("dropout",
#                                                                   "Treatment",
#                                                                   selected.var.1,
#                                                                   selected.var.2,
#                                                                   selected.var.3,
#                                                                   selected.var.4)]),]
# 
# # setup model equation:
# baseform <- paste("dropout ~ Treatment", selected.var.1,
#                   selected.var.2, selected.var.3, selected.var.4, sep = " + ")

At the fourth iteration in the forward selection process, no variables have p<0.1 to add to the model. Let’s check the final model and ensure all variables selected remain statistically significant.

\[ Dropout = Treatment + Age + Sex + Saturated \space fats \]

Final Logistic Model

# Fit logistic regression model
dropout_model <- glm(as.formula(baseform),
                     data = follow_up_data, 
                     family = binomial(link = "logit"))
# family = binomial(link = "logit") is equivalent to family = binomial

# View summary of the model
# summary(dropout_model)


tbl_regression(dropout_model,
    exponentiate = TRUE,
    pvalue_fun = ~ style_pvalue(.x, digits = 3),
    estimate_fun =  ~ style_number(.x, digits = 2),
    #label = label_list
  ) %>%
  add_global_p() %>%
  modify_table_styling(
    column = estimate,
    rows = !is.na(estimate),
    cols_merge_pattern = "{estimate} ({conf.low})",
    label = "**Estimate (95% CI)**"
  )
Characteristic Estimate (95% CI) p-value
Treatment
<0.001
    Control
    WW 5.62 (2.24)
Age_years 0.96 (0.92) 0.007
Sex_bcf
0.022
    Female
    Male 0.23 (0.04)
SFAT_ave_bl 0.97 (0.93) 0.081
Abbreviations: CI = Confidence Interval, OR = Odds Ratio
# Get predicted probabilities or log-odds
follow_up_data$predicted_log_odds <- predict(dropout_model, type = "link")     # log-odds
follow_up_data$predicted_probabilities <- predict(dropout_model, type = "response")  # probabilities
#likelihood_dropout


We use this model to calculate predicted probabilities and log odds. Log odds are used as a covariate in the LMM model in the next section.

\[\text{log-odds} = \text{log} \bigg(\frac{\text{probability}}{1 - \text{probability}} \bigg)\]



LMM

\[ Original \space score = baseline + Sex + Age + Race + Ethnicity + Education + Dropout \space log \text{-} odds + \\ Treatment + Time + Treatment:Time + (1|WINS.ID) \]

#######################
## Data prep for LMM ##
#######################

# add predicted log-odds to the data:

temp <- merge(raw_data, 
              follow_up_data[,c("WINS.ID", "predicted_log_odds")],
              by = "WINS.ID")

df.bl <- temp %>%
  dplyr::select(WINS.ID, ends_with("_bl")) %>%
  dplyr::rename_with(~str_remove(., '_bl')) %>%
  dplyr::mutate(Time = "baseline")

df.el <- temp %>%
  dplyr::select(WINS.ID, ends_with("_el")) %>%
  dplyr::rename_with(~str_remove(., '_el')) %>%
  dplyr::mutate(Time = "endline")

df.other <- temp %>% 
  dplyr::select(-c(ends_with("_el")))

df_long <- df.other %>% full_join(dplyr::bind_rows(df.bl, df.el), by = join_by(WINS.ID)) %>%
  arrange(WINS.ID, Time)
# LMM on continuous outcomes with longitudinal data:
outcomes <- outcome_pairs$outcome
yvars = setdiff(outcomes, c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl", "changekg_percent_body_wt"))
output_dropout = NULL
output_dropout_raw = NULL

for (yvar in yvars){
  # Model
  formula = as.formula(paste0(gsub("_change", "", yvar), " ~ ", gsub("_change", "_bl", yvar), 
                              " + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + 
                              Education_grouped + predicted_log_odds +  Treatment*Time + (1|WINS.ID)"))
  mod = lmer(formula, data = df_long)
  
  
  # Estimated means and contrasts
  em = emmeans(mod, revpairwise ~ Time|Treatment)
  contrast = data.frame(em$contrasts)
  did = data.frame(pairs(pairs(emmeans(mod, ~ Time|Treatment), reverse = TRUE), by = NULL))
  did_CI = confint(pairs(pairs(emmeans(mod, ~ Time|Treatment), reverse = TRUE), by = NULL))
  out = data.frame(Outcomes = yvar,
                   group1_mean = round(contrast[contrast$Treatment == "Weight Watchers", "estimate"], 2),
                   group1_se = round(contrast[contrast$Treatment == "Weight Watchers", "SE"], 2),
                   group2_mean = round(contrast[contrast$Treatment == "Control", "estimate"], 2),
                   group2_se = round(contrast[contrast$Treatment == "Control", "SE"], 2),
                   diff_mean = round(did[, "estimate"], 2),
                   diff_CI = paste0("(", sprintf("%.2f", did_CI[, "lower.CL"]), ", ", sprintf("%.2f", did_CI[, "upper.CL"]), ")"),
                   diff_se = round(did[, "SE"], 2),
                   diff_t = round(did[, "t.ratio"], 2),
                   diff_df = round(did[, "df"], 2),
                   diff_p = did[, "p.value"])
  
    out_raw = data.frame(Outcomes = yvar,
                   group1_mean = contrast[contrast$Treatment == "Weight Watchers", "estimate"],
                   group1_se = contrast[contrast$Treatment == "Weight Watchers", "SE"],
                   group2_mean = contrast[contrast$Treatment == "Control", "estimate"],
                   group2_se = contrast[contrast$Treatment == "Control", "SE"],
                   diff_mean = did[, "estimate"],
                   diff_LB = did_CI[, "lower.CL"],
                   diff_UB = did_CI[, "upper.CL"],
                   diff_se = did[, "SE"],
                   diff_t = did[, "t.ratio"],
                   diff_df = did[, "df"],
                   diff_p = did[, "p.value"])
  
  output_dropout = rbind(output_dropout, out)
  
  output_dropout_raw = rbind(output_dropout_raw, out_raw)
  
  # Optionl returns while loop running:
  #print(paste0(yvar, " outcome ", which(yvars == yvar), " of ", length(yvars),"."))
}

output_dropout_saved <- output_dropout

# combine output with labels, select desired columns, and remove _change from outcome names
output_dropout = output_dropout  %>% 
  dplyr::rename("outcome" = "Outcomes") %>% 
  left_join(outcome_pairs, by = "outcome") %>% 
  dplyr::select(1,12,2:11) %>% 
  mutate(outcome = gsub("_change", "", outcome))

output_dropout_raw = output_dropout_raw  %>% 
  dplyr::rename("outcome" = "Outcomes") %>% 
  left_join(outcome_pairs, by = "outcome") %>% 
  dplyr::select(1,13,2:12) %>% 
  mutate(outcome = gsub("_change", "", outcome))

# round to 2 places and keep both places:
non_pvals = c("group1_mean", "group1_se", "group2_mean", "group2_se", 
              "diff_mean", "diff_se", "diff_t", "diff_df")
output_dropout[,non_pvals] = apply(output_dropout[, non_pvals], 2, function(x) sprintf("%.2f", x))

# save for table 3 usage where round p-values differently:
output_dropout2 <- output_dropout

# round p-values to 3 places:
output_dropout2 <- output_dropout2 %>% 
  mutate(
    diff_p = case_when(.data[["diff_p"]] < 0.001 ~ sub(" ", "", format.pval(.data[["diff_p"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["diff_p"]], digits = 3, format = "f")))

# table of results
kable(output_dropout2,
      col.names = c("Variable", "Outcome", "Mean", "SE", "Mean", "SE", "Mean", "95% CI", "SE", "t", "df", "p-value"),
      caption = "LMM on all people") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 2,  "Weight Watchers" = 2, "Control" = 2, "Difference" = 3, "Model Statistics" = 3)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6-4,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
LMM on all people
Weight Watchers
Control
Difference
Model Statistics
Variable Outcome Mean SE Mean SE Mean 95% CI SE t df p-value
Change in Dietary Quality Measures (including HEI subscores)
HEI2015_TOTAL_SCORE HEI Total Score 3.89 0.92 -0.07 0.89 3.96 (1.43, 6.49) 1.28 3.08 365.73 0.002
HEI2015C1_TOTALVEG Total Vegetable 0.21 0.09 0.10 0.09 0.11 (-0.15, 0.36) 0.13 0.80 365.72 0.424
HEI2015C2_GREEN_AND_BEAN Greens and Beans 0.50 0.16 -0.00 0.16 0.50 (0.06, 0.95) 0.23 2.22 365.72 0.027
HEI2015C3_TOTALFRUIT Total Fruit 0.51 0.14 0.00 0.13 0.51 (0.14, 0.88) 0.19 2.70 365.71 0.007
HEI2015C4_WHOLEFRUIT Whole Fruit 0.37 0.15 -0.10 0.15 0.47 (0.05, 0.88) 0.21 2.20 365.72 0.028
HEI2015C5_WHOLEGRAIN Whole Grains 0.28 0.26 0.00 0.25 0.28 (-0.44, 0.99) 0.36 0.76 365.73 0.447
HEI2015C6_TOTALDAIRY Total Dairy -0.18 0.23 -0.12 0.22 -0.06 (-0.68, 0.57) 0.32 -0.17 365.72 0.862
HEI2015C7_TOTPROT Total Protein Foods 0.12 0.06 0.06 0.05 0.05 (-0.10, 0.21) 0.08 0.68 365.72 0.494
HEI2015C8_SEAPLANT_PROT Seafood and Plant Proteins -0.19 0.16 -0.16 0.16 -0.03 (-0.47, 0.41) 0.22 -0.15 365.71 0.884
HEI2015C9_FATTYACID Fatty Acids 0.61 0.26 0.30 0.25 0.31 (-0.41, 1.03) 0.37 0.85 365.72 0.399
HEI2015C10_SODIUM Sodium -0.64 0.22 -0.61 0.21 -0.03 (-0.62, 0.56) 0.30 -0.10 365.73 0.920
HEI2015C11_REFINEDGRAIN Refined Grains 0.78 0.26 -0.46 0.25 1.24 (0.52, 1.95) 0.36 3.41 365.72 <0.001
HEI2015C12_SFAT Saturated Fats 1.07 0.26 0.53 0.25 0.54 (-0.17, 1.24) 0.36 1.50 365.71 0.133
HEI2015C13_ADDSUG Added Sugars 0.44 0.16 0.37 0.16 0.08 (-0.37, 0.53) 0.23 0.34 365.70 0.735
amed AMED Score -0.07 0.38 -0.47 0.37 0.41 (-0.63, 1.44) 0.53 0.77 365.72 0.441
Change in Micro and Macro Nutrients
KCAL_ave Average Total Energy -419.89 43.96 -244.49 42.41 -175.40 (-295.53, -55.28) 61.09 -2.87 365.71 0.004
TFAT_ave Average Total Fat -21.24 2.33 -11.54 2.25 -9.70 (-16.07, -3.33) 3.24 -2.99 365.72 0.003
CARB_ave Average Total Carbohydrates -46.87 5.22 -28.10 5.03 -18.76 (-33.02, -4.50) 7.25 -2.59 365.69 0.010
SODI_ave Average Sodium -577.67 80.67 -267.65 77.82 -310.02 (-530.47, -89.58) 112.10 -2.77 365.72 0.006
SFAT_ave Average Saturated Fats -7.57 0.90 -4.13 0.87 -3.45 (-5.91, -0.98) 1.25 -2.75 365.74 0.006
SUGR_ave Average Total Sugars -17.78 2.86 -14.46 2.76 -3.32 (-11.14, 4.51) 3.98 -0.83 365.69 0.405
ADD_SUGARS_ave Average Added Sugars -3.77 0.60 -2.62 0.58 -1.15 (-2.78, 0.48) 0.83 -1.39 365.69 0.167
CHOLE_ave Average Total Cholesterol -39.27 13.31 -23.26 12.84 -16.02 (-52.38, 20.35) 18.49 -0.87 365.71 0.387
FIBE_ave Average Fiber -2.06 0.55 -1.89 0.53 -0.17 (-1.68, 1.34) 0.77 -0.23 365.73 0.822
Weight Loss Measures
weightkg Body Weight (kg) -5.45 0.44 -1.46 0.42 -3.99 (-5.19, -2.79) 0.61 -6.53 362.33 <0.001
BMI BMI -1.91 0.15 -0.51 0.15 -1.40 (-1.81, -0.99) 0.21 -6.67 362.32 <0.001
Change in Physical Activity
METS Total Physical Activity MET 496.43 199.26 564.30 191.10 -67.87 (-610.79, 475.05) 276.08 -0.25 362.43 0.806
sendentary Sedentary -68.13 14.28 -33.90 13.70 -34.22 (-73.14, 4.69) 19.79 -1.73 362.40 0.085
moderate Moderate 176.14 133.17 203.54 127.71 -27.41 (-390.25, 335.44) 184.51 -0.15 362.46 0.882
vigorous Vigorous 329.67 131.07 362.14 125.70 -32.47 (-389.60, 324.66) 181.61 -0.18 362.37 0.858
Change Self-Reported Sleep
sleep_quality Sleep Quality -0.05 0.05 0.18 0.05 -0.23 (-0.38, -0.08) 0.08 -3.03 365.72 0.003
sleep_amount Usual Sleep Amount -0.05 0.03 0.05 0.03 -0.10 (-0.18, -0.02) 0.04 -2.39 365.73 0.017
wake_episodes Wake Episodes -0.04 0.09 -0.04 0.08 0.01 (-0.22, 0.24) 0.12 0.08 364.52 0.940
Change in Habit Strength
SRBAI SRBAI Habit Strength 0.80 0.06 0.27 0.06 0.53 (0.36, 0.69) 0.08 6.29 362.45 <0.001
Avg1 Considering Portion Sizes 1.12 0.12 0.66 0.12 0.46 (0.12, 0.80) 0.17 2.68 362.43 0.008
Avg2 Tracking Food Consumption 1.28 0.14 0.79 0.14 0.48 (0.10, 0.87) 0.20 2.47 362.44 0.014
Avg3 Consider WW Points 3.34 0.14 0.69 0.14 2.64 (2.25, 3.04) 0.20 13.22 362.43 <0.001
Avg4 Frequency of Eating Vegetables 0.56 0.11 0.29 0.11 0.27 (-0.03, 0.57) 0.15 1.76 362.46 0.080
Avg5 Frequency of Weighing Self 1.01 0.13 0.42 0.12 0.58 (0.23, 0.94) 0.18 3.24 362.45 0.001
Avg6 Frequency of Physical Activity 0.68 0.12 0.36 0.11 0.32 (-0.00, 0.63) 0.16 1.96 362.43 0.051
Avg7 Talking Kindly to Self After Setback 0.69 0.13 0.18 0.12 0.51 (0.15, 0.86) 0.18 2.83 362.45 0.005
Avg8 Arranging Healthy Foods for Easy Access 1.09 0.16 0.43 0.15 0.65 (0.23, 1.08) 0.22 3.02 362.39 0.003
Avg9 Frequency of Fried Foods -0.71 0.13 -0.28 0.12 -0.43 (-0.77, -0.09) 0.17 -2.49 362.45 0.013
Avg10 Frequency of Sweets -1.30 0.14 -0.50 0.13 -0.79 (-1.17, -0.42) 0.19 -4.17 362.45 <0.001
Avg11 Frequency of Sugary Beverages -0.79 0.13 -0.38 0.13 -0.42 (-0.77, -0.06) 0.18 -2.31 362.41 0.021
Avg12 Snacking When Not Hungry -0.79 0.13 -0.50 0.13 -0.29 (-0.66, 0.07) 0.19 -1.59 362.45 0.113
UnhSRBAI Unhealthy Grouped -0.90 0.09 -0.41 0.09 -0.49 (-0.74, -0.23) 0.13 -3.76 362.45 <0.001
healSRBAI Healthy Grouped 1.22 0.07 0.48 0.07 0.74 (0.54, 0.93) 0.10 7.36 362.44 <0.001

Note: there are four weight loss outcomes missing from the LMM Sensitivity analysis because they did not have an endline and baseline measure for longitudinal modeling.

Comparison

Comparing main analysis LMMs against the LMM with predicted log-odds for dropout added as a covariate.

# let's merge the raw lmm output with the primary output to compare p-values
colnames(output_dropout)[2] = "Outcome_label"
comparison <- merge(output_lmm[,c("Outcome_label", "diff_mean", "diff_p")], 
                    output_dropout[,c("Outcome_label", "diff_mean", "diff_p")],
                    by = "Outcome_label", sort = FALSE, suffixes = c(".LMM",".Dropout"))

# make p-values numeric
comparison$diff_mean.LMM = as.numeric(comparison$diff_mean.LMM)
comparison$diff_mean.Dropout = as.numeric(comparison$diff_mean.Dropout)
comparison$diff_p.LMM = as.numeric(comparison$diff_p.LMM)
comparison$diff_p.Dropout = as.numeric(comparison$diff_p.Dropout)
# add a variable indicating if p-values changed significance level
comparison <- comparison %>%  mutate(
  change = case_when(diff_p.LMM < 0.05 & diff_p.Dropout < 0.05 ~ "No Change",
                     diff_p.LMM > 0.05 & diff_p.Dropout > 0.05 ~ "No Change",
                     diff_p.LMM < 0.05 & diff_p.Dropout > 0.05 ~ "Change",
                     diff_p.LMM > 0.05 & diff_p.Dropout < 0.05 ~ "Change")
)

# format table to display changes
colnames(comparison) =c("Outcome", "LMM Difference", "LMM p-value", "Dropout Difference", "Dropout p-value", "Change")

table(comparison$Change)
## 
##    Change No Change 
##         1        47

47 of the 48 outcomes did not change in level of significance between the main LMM and sensitivity Dropout analysis.

The 1 outcomes that did result in a level of significant change are as follows:

comparison.flips <- comparison[which(comparison$Change == "Change"), -6]
comparison.flips$color = 0
comparison.flips$color[comparison.flips$`LMM p-value` < comparison.flips$`Dropout p-value`] = 1
rownames(comparison.flips) = NULL

comparison.flips[,2] = formatC(comparison.flips[,2], digits = 3, format = "f")
comparison.flips[,3] = formatC(comparison.flips[,3], digits = 3, format = "f")
comparison.flips[,4] = formatC(comparison.flips[,4], digits = 3, format = "f")
comparison.flips[,5] = formatC(comparison.flips[,5], digits = 3, format = "f")

kable(comparison.flips[,-c(2, 4, 6)]) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()  %>%
  row_spec(which(comparison.flips$color >0), color = "red") %>%
  row_spec(which(comparison.flips$color <1), color = "blue")
Outcome LMM p-value Dropout p-value
Frequency of Physical Activity 0.050 0.051


With the entire list of outcomes below:

comparison$color = 0
comparison$color[comparison$Change == "Change"] = 1
rownames(comparison) = NULL

comparison[,2] = formatC(comparison[,2], digits = 3, format = "f")
comparison[,3] = formatC(comparison[,3], digits = 3, format = "f")
comparison[,4] = formatC(comparison[,4], digits = 3, format = "f")
comparison[,5] = formatC(comparison[,5], digits = 3, format = "f")

kable(comparison[,c(1, 2, 4, 3, 5)]) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()  %>%
  row_spec(which(comparison$color >0), color = "red") %>%
  row_spec(which(comparison$color <1), color = "blue")
Outcome LMM Difference Dropout Difference LMM p-value Dropout p-value
HEI Total Score 3.970 3.960 0.002 0.002
Total Vegetable 0.100 0.110 0.425 0.424
Greens and Beans 0.500 0.500 0.027 0.027
Total Fruit 0.510 0.510 0.007 0.007
Whole Fruit 0.470 0.470 0.028 0.028
Whole Grains 0.280 0.280 0.445 0.447
Total Dairy -0.060 -0.060 0.862 0.862
Total Protein Foods 0.050 0.050 0.490 0.494
Seafood and Plant Proteins -0.030 -0.030 0.889 0.884
Fatty Acids 0.310 0.310 0.399 0.399
Sodium -0.030 -0.030 0.924 0.920
Refined Grains 1.240 1.240 0.001 0.001
Saturated Fats 0.540 0.540 0.133 0.133
Added Sugars 0.080 0.080 0.741 0.735
AMED Score 0.410 0.410 0.433 0.441
Average Total Energy -175.740 -175.400 0.004 0.004
Average Total Fat -9.680 -9.700 0.003 0.003
Average Total Carbohydrates -18.680 -18.760 0.010 0.010
Average Sodium -310.020 -310.020 0.006 0.006
Average Saturated Fats -3.450 -3.450 0.006 0.006
Average Total Sugars -3.250 -3.320 0.414 0.405
Average Added Sugars -1.140 -1.150 0.169 0.167
Average Total Cholesterol -16.090 -16.020 0.385 0.387
Average Fiber -0.170 -0.170 0.825 0.822
Body Weight (kg) -3.990 -3.990 0.000 0.000
BMI -1.400 -1.400 0.000 0.000
Total Physical Activity MET -66.940 -67.870 0.808 0.806
Sedentary -34.270 -34.220 0.084 0.085
Moderate -26.400 -27.410 0.886 0.882
Vigorous -32.580 -32.470 0.858 0.858
Sleep Quality -0.230 -0.230 0.003 0.003
Usual Sleep Amount -0.100 -0.100 0.018 0.017
Wake Episodes 0.010 0.010 0.937 0.940
SRBAI Habit Strength 0.530 0.530 0.000 0.000
Considering Portion Sizes 0.460 0.460 0.008 0.008
Tracking Food Consumption 0.480 0.480 0.014 0.014
Consider WW Points 2.640 2.640 0.000 0.000
Frequency of Eating Vegetables 0.270 0.270 0.081 0.080
Frequency of Weighing Self 0.590 0.580 0.001 0.001
Frequency of Physical Activity 0.320 0.320 0.050 0.051
Talking Kindly to Self After Setback 0.510 0.510 0.005 0.005
Arranging Healthy Foods for Easy Access 0.650 0.650 0.003 0.003
Frequency of Fried Foods -0.430 -0.430 0.013 0.013
Frequency of Sweets -0.790 -0.790 0.000 0.000
Frequency of Sugary Beverages -0.420 -0.420 0.021 0.021
Snacking When Not Hungry -0.290 -0.290 0.115 0.113
Unhealthy Grouped -0.490 -0.490 0.000 0.000
Healthy Grouped 0.740 0.740 0.000 0.000



Complete-Case Analysis

Secondary analysis for “completers only” analysis

\[ Outcome = Baseline + Sex + Age + Race + Ethnicity + Education + Treatment \]

# Thank you to Xiwei Chen for this code:

yvars = outcome_pairs$outcome
output.glm = output.lm = NULL

for (yvar in yvars){
  # Model
  if (yvar %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")){
    formula = as.formula(paste0(yvar, 
                                " ~ weightkg_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment"))
    mod = glm(formula, data = raw_data, family = "binomial")
  } else if (yvar == "changekg_percent_body_wt"){
    formula = as.formula(paste0(yvar, 
                                " ~ weightkg_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment"))
    mod = lm(formula, data = raw_data)
  } else if (yvar %in% c("FCITotal_change", "FCIFat_change", "FCISweet_change", "FCICarb_change", "FCIFFF_change", "FCIFrVeg_change",
                         "hunger_change", "IWQOL_change", "PhysicalFx_change", "selfesteem_change", "SexualLife_change", 
                         "Publicdistress_change", "work_change", "Selfcomp_change", "human_change", "kindness_change", 
                         "mindfulness_change", "judge_change", "isolation_change", "overident_change", "wellbeing_change",
                         "Perstress_change", "wbis_change", "Selfdev_change", "Distress_change", "PEMS_change", "EDEQ_change",
                         "restraintTFEQ_change", "dishinibitionTFEQ_change", "bodyapp_change")){
    formula = as.formula(paste0(yvar, " ~ ", gsub("_change", "_bl", yvar), 
                                " + BMI_bl + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment"))
    mod = lm(formula, data = raw_data)
  } else {
    formula = as.formula(paste0(yvar, " ~ ", gsub("_change", "_bl", yvar), 
                                " + Sex_bcf + Age_years + Race2_bcf + Ethnicity_bcf + Education_grouped + Treatment"))
    mod = lm(formula, data = raw_data)
  }
  
  # Estimated means and contrasts
  if (yvar %in% c("achieve_3_percent_wl", "achieve_5_percent_wl", "achieve_10_percent_wl")){
    em = emmeans(mod, pairwise ~ Treatment, type = "response")
    emmean = data.frame(em$emmeans); contrast = data.frame(em$contrasts)
    em_CI = confint( pairs(emmeans(em, "Treatment", type = "response")))
    out = data.frame(Outcomes = yvar,
                     n = nrow(mod$model),
                     # group1_prob, group2_prob, diff_or
                     group1_mean = round(emmean[emmean$Treatment == "Weight Watchers", "prob"], 2),
                     group1_se = round(emmean[emmean$Treatment == "Weight Watchers", "SE"], 2),
                     group2_mean = round(emmean[emmean$Treatment == "Control", "prob"], 2),
                     group2_se = round(emmean[emmean$Treatment == "Control", "SE"], 2),
                     diff_mean = round(contrast[, "odds.ratio"], 2),
                     diff_LB = round(em_CI[, "asymp.LCL"], 2),
                     diff_UB = round(em_CI[, "asymp.UCL"], 2),
                     diff_se = round(contrast[, "SE"], 2),
                     diff_stat = round(contrast[, "z.ratio"], 2),
                     diff_df = round(contrast[, "df"], 2),
                     diff_p = contrast[, "p.value"],
                     Cohens_d = NA)
    
    output.glm = rbind(output.glm, out)
  } else {
    em = emmeans(mod, pairwise ~ Treatment)
    emmean = data.frame(em$emmeans); contrast = data.frame(em$contrasts)
    em_CI = confint( pairs(emmeans(em, "Treatment")))
    effect_size = data.frame(eff_size(em$emmeans, sigma = sigma(mod), edf = contrast[, "df"]))
    out = data.frame(Outcomes = yvar,
                     n = nrow(mod$model),
                     group1_mean = round(emmean[emmean$Treatment == "Weight Watchers", "emmean"], 2),
                     group1_se = round(emmean[emmean$Treatment == "Weight Watchers", "SE"], 2),
                     group2_mean = round(emmean[emmean$Treatment == "Control", "emmean"], 2),
                     group2_se = round(emmean[emmean$Treatment == "Control", "SE"], 2),
                     diff_mean = round(contrast[, "estimate"], 2),
                     diff_LB = round(em_CI[, "lower.CL"], 2),
                     diff_UB = round(em_CI[, "upper.CL"], 2),
                     diff_se = round(contrast[, "SE"], 2),
                     diff_stat = round(contrast[, "t.ratio"], 2),
                     diff_df = round(contrast[, "df"], 2),
                     diff_p = contrast[, "p.value"],
                     Cohens_d = round(effect_size[, "effect.size"], 2))
    
    output.lm = rbind(output.lm, out)
  }
}

Model Results

# Combine glm and lm results in one table
completers_df <- rbind(output.lm, output.glm)

completers_df = completers_df %>% dplyr::rename("outcome" = "Outcomes") %>% left_join(outcome_pairs, by = "outcome") %>% dplyr::select(1,15,2:14)

# order for labels:
completers_df <- completers_df[match(outcome_pairs$outcome, completers_df$outcome), ]
rownames(completers_df) <- NULL

# format p-values
completers_df2 <- completers_df %>% 
  mutate(
    diff_p = case_when(.data[["diff_p"]] < 0.001 ~ sub(" ", "", format.pval(.data[["diff_p"]], eps = 0.001, digits = 3, nsmall=3)),
                        TRUE ~ formatC(.data[["diff_p"]], digits = 3, format = "f")),
    diff_CI = paste0("(", formatC(diff_LB, digits = 2, format = "f"), ", ", 
                           formatC(diff_UB, digits = 2, format = "f"), ")")
    
  ) %>% select(
     outcome, outcome_labels, n, group1_mean, group1_se, group2_mean, group2_se, 
     diff_mean, diff_CI, diff_se, diff_stat, diff_df, diff_p, Cohens_d
  )

# let's identify 3 binary outcomes
completers_df2$outcome_labels[grep("Achieved", completers_df2$outcome_labels)] = paste0(completers_df2$outcome_labels[grep("Achieved", completers_df2$outcome_labels)], "*")

kable(completers_df2,
      col.names = c("Variable", "Outcome", "N", "Mean", "SE", "Mean", "SE", "Mean" ,"95% CI", "SE", "Statistic", "df", "p-value", "Cohen's d"),
      caption = "ANCOVA on complete-cases") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  add_header_above(c(" " = 3,  "Weight Watchers" = 2, "Control" = 2, "Difference" = 3, "Model Statistics" = 3, " " = 1)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
ANCOVA on complete-cases
Weight Watchers
Control
Difference
Model Statistics
Variable Outcome N Mean SE Mean SE Mean 95% CI SE Statistic df p-value Cohen’s d
Change in Dietary Quality Measures (including HEI subscores)
HEI2015_TOTAL_SCORE_change HEI Total Score 341 5.35 1.53 1.21 1.37 4.14 (1.74, 6.54) 1.22 3.39 330 <0.001 0.37
HEI2015C1_TOTALVEG_change Total Vegetable 341 0.16 0.16 0.05 0.14 0.12 (-0.13, 0.36) 0.13 0.92 330 0.359 0.10
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 341 0.94 0.26 0.26 0.24 0.68 (0.27, 1.10) 0.21 3.24 330 0.001 0.36
HEI2015C3_TOTALFRUIT_change Total Fruit 341 0.44 0.23 -0.06 0.21 0.51 (0.14, 0.87) 0.18 2.74 330 0.007 0.30
HEI2015C4_WHOLEFRUIT_change Whole Fruit 341 0.08 0.26 -0.41 0.23 0.49 (0.09, 0.89) 0.21 2.38 330 0.018 0.26
HEI2015C5_WHOLEGRAIN_change Whole Grains 341 1.02 0.43 0.52 0.39 0.49 (-0.19, 1.17) 0.35 1.41 330 0.158 0.16
HEI2015C6_TOTALDAIRY_change Total Dairy 341 -0.61 0.38 -0.31 0.34 -0.30 (-0.90, 0.30) 0.31 -1.00 330 0.319 -0.11
HEI2015C7_TOTPROT_change Total Protein Foods 341 0.11 0.08 0.07 0.07 0.04 (-0.09, 0.17) 0.06 0.58 330 0.560 0.06
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 341 0.29 0.26 0.14 0.23 0.15 (-0.26, 0.55) 0.21 0.71 330 0.481 0.08
HEI2015C9_FATTYACID_change Fatty Acids 341 1.43 0.42 1.13 0.38 0.30 (-0.36, 0.96) 0.34 0.90 330 0.368 0.10
HEI2015C10_SODIUM_change Sodium 341 -1.16 0.36 -0.91 0.32 -0.25 (-0.81, 0.31) 0.28 -0.89 330 0.373 -0.10
HEI2015C11_REFINEDGRAIN_change Refined Grains 341 0.53 0.42 -0.55 0.38 1.08 (0.42, 1.74) 0.34 3.21 330 0.001 0.35
HEI2015C12_SFAT_change Saturated Fats 341 1.59 0.43 0.99 0.39 0.60 (-0.08, 1.28) 0.34 1.74 330 0.082 0.19
HEI2015C13_ADDSUG_change Added Sugars 341 0.64 0.28 0.40 0.25 0.24 (-0.19, 0.68) 0.22 1.10 330 0.272 0.12
amed_change AMED Score 341 0.85 0.64 0.25 0.58 0.60 (-0.41, 1.62) 0.52 1.17 330 0.243 0.13
Change in Micro and Macro Nutrients
KCAL_ave_change Average Total Energy 341 -466.34 73.19 -233.36 66.04 -232.99 (-348.17, -117.80) 58.56 -3.98 330 <0.001 -0.44
TFAT_ave_change Average Total Fat 341 -22.65 3.89 -9.73 3.50 -12.91 (-19.05, -6.78) 3.12 -4.14 330 <0.001 -0.46
CARB_ave_change Average Total Carbohydrates 341 -48.93 8.73 -25.44 7.86 -23.48 (-37.20, -9.77) 6.97 -3.37 330 <0.001 -0.37
SODI_ave_change Average Sodium 341 -520.19 132.27 -161.11 119.20 -359.07 (-565.92, -152.22) 105.15 -3.41 330 <0.001 -0.38
SFAT_ave_change Average Saturated Fats 341 -8.52 1.47 -4.21 1.32 -4.31 (-6.63, -1.99) 1.18 -3.65 330 <0.001 -0.40
SUGR_ave_change Average Total Sugars 341 -24.27 4.83 -16.77 4.33 -7.51 (-15.14, 0.13) 3.88 -1.93 330 0.054 -0.21
ADD_SUGARS_ave_change Average Added Sugars 341 -5.02 1.00 -3.10 0.89 -1.91 (-3.48, -0.34) 0.80 -2.40 330 0.017 -0.26
CHOLE_ave_change Average Total Cholesterol 341 -50.84 22.58 -25.14 20.30 -25.70 (-61.16, 9.77) 18.03 -1.43 330 0.155 -0.16
FIBE_ave_change Average Fiber 341 -1.65 0.95 -1.38 0.85 -0.27 (-1.76, 1.22) 0.76 -0.36 330 0.721 -0.04
Weight Loss Measures
weightkg_change Body Weight (kg) 329 -5.69 0.83 -1.74 0.74 -3.95 (-5.25, -2.65) 0.66 -5.99 318 <0.001 -0.67
BMI_change BMI 329 -1.99 0.29 -0.61 0.25 -1.38 (-1.83, -0.93) 0.23 -6.07 318 <0.001 -0.68
changekg_percent_body_wt Percent Body Weight Change 329 -5.74 0.84 -1.75 0.75 -3.99 (-5.30, -2.67) 0.67 -5.97 318 <0.001 -0.67
achieve_3_percent_wl Achieved 3% Weight Loss* 329 0.62 0.07 0.35 0.06 3.01 (1.89, 4.80) 0.71 4.65 Inf <0.001 NA
achieve_5_percent_wl Achieved 5% Weight Loss* 329 0.51 0.08 0.21 0.05 3.75 (2.30, 6.10) 0.93 5.31 Inf <0.001 NA
achieve_10_percent_wl Achieved 10% Weight Loss* 329 0.19 0.08 0.03 0.02 6.59 (2.92, 14.89) 2.74 4.54 Inf <0.001 NA
Change in Physical Activity
METS_change Total Physical Activity MET 327 843.55 366.77 821.08 326.33 22.47 (-546.52, 591.46) 289.19 0.08 316 0.938 0.01
sendentary_change Sedentary 327 -72.61 25.12 -41.72 22.54 -30.90 (-69.94, 8.15) 19.85 -1.56 316 0.121 -0.18
moderate_change Moderate 327 323.19 226.46 301.03 201.70 22.16 (-330.28, 374.60) 179.13 0.12 316 0.902 0.01
vigorous_change Vigorous 327 615.04 245.40 583.62 218.77 31.42 (-350.64, 413.48) 194.19 0.16 316 0.872 0.02
Change Self-Reported Sleep
sleep_quality_change Sleep Quality 341 -0.01 0.10 0.22 0.09 -0.22 (-0.38, -0.07) 0.08 -2.86 330 0.005 -0.31
sleep_amount_change Usual Sleep Amount 341 -0.07 0.05 0.03 0.04 -0.10 (-0.17, -0.02) 0.04 -2.41 330 0.016 -0.27
wake_episodes_change Wake Episodes 336 -0.01 0.15 -0.04 0.14 0.03 (-0.21, 0.27) 0.12 0.25 325 0.800 0.03
Change in Habit Strength
SRBAI_change SRBAI Habit Strength 327 0.92 0.11 0.40 0.10 0.53 (0.36, 0.69) 0.08 6.21 316 <0.001 0.70
Avg1_change Considering Portion Sizes 327 1.09 0.20 0.61 0.18 0.48 (0.17, 0.80) 0.16 3.03 316 0.003 0.34
Avg2_change Tracking Food Consumption 327 1.55 0.25 0.93 0.22 0.61 (0.23, 1.00) 0.20 3.12 316 0.002 0.35
Avg3_change Consider WW Points 327 3.73 0.26 1.10 0.24 2.63 (2.21, 3.04) 0.21 12.54 316 <0.001 1.41
Avg4_change Frequency of Eating Vegetables 327 0.70 0.19 0.41 0.17 0.29 (-0.01, 0.59) 0.15 1.91 316 0.058 0.21
Avg5_change Frequency of Weighing Self 327 1.04 0.23 0.45 0.20 0.59 (0.23, 0.95) 0.18 3.25 316 0.001 0.37
Avg6_change Frequency of Physical Activity 327 0.48 0.21 0.19 0.18 0.29 (-0.03, 0.61) 0.16 1.80 316 0.073 0.20
Avg7_change Talking Kindly to Self After Setback 327 0.89 0.22 0.50 0.20 0.39 (0.04, 0.74) 0.18 2.18 316 0.030 0.25
Avg8_change Arranging Healthy Foods for Easy Access 327 1.36 0.26 0.66 0.23 0.70 (0.30, 1.11) 0.21 3.40 316 <0.001 0.38
Avg9_change Frequency of Fried Foods 327 -0.48 0.22 -0.10 0.20 -0.38 (-0.73, -0.03) 0.18 -2.13 316 0.034 -0.24
Avg10_change Frequency of Sweets 327 -1.47 0.24 -0.69 0.21 -0.78 (-1.15, -0.41) 0.19 -4.11 316 <0.001 -0.46
Avg11_change Frequency of Sugary Beverages 327 -0.74 0.23 -0.26 0.20 -0.48 (-0.84, -0.12) 0.18 -2.65 316 0.008 -0.30
Avg12_change Snacking When Not Hungry 327 -0.81 0.24 -0.55 0.21 -0.26 (-0.63, 0.11) 0.19 -1.38 316 0.168 -0.16
UnhSRBAI_change Unhealthy Grouped 327 -0.86 0.16 -0.39 0.15 -0.48 (-0.73, -0.22) 0.13 -3.63 316 <0.001 -0.41
healSRBAI_change Healthy Grouped 327 1.34 0.13 0.60 0.11 0.74 (0.54, 0.94) 0.10 7.32 316 <0.001 0.82

\(^*\) These are binary outcomes with probabilities for group means and OR for mean difference.

Comparison

# Compare p-values of raw output, unrounded p-values:
colnames(completers_df)[2] = "Outcome_label"
comparison <- merge(primary_results[,c("Outcome_label", "p_value")], completers_df[,c("Outcome_label", "diff_p")], 
                    by = "Outcome_label", sort = FALSE)

# make p-values numeric
comparison$p_value = as.numeric(comparison$p_value)
comparison$diff_p = as.numeric(comparison$diff_p)

comparison <- comparison %>% mutate(
  change = case_when(p_value < 0.05 & diff_p < 0.05 ~ "No Change",
                     p_value > 0.05 & diff_p > 0.05 ~ "No Change",
                     p_value < 0.05 & diff_p > 0.05 ~ "Change",
                     p_value > 0.05 & diff_p < 0.05 ~ "Change")
)

#table(comparison$change)
colnames(comparison) =c("Outcome", "Primary p-value", "Completers p-value", "Change")
comparison[,2:3] = round(comparison[,2:3], 3)

table(comparison$Change)
## 
##    Change No Change 
##         5        47

47 of the 52 outcomes did not change in level of significance between the primary and complete case sensitivity analysis.

The 5 outcomes that did result in a level of significant change are as follows:

# Display results that changed in significance
comparison.flips <- comparison[which(comparison$Change == "Change"), -4]
comparison.flips$color = 0
comparison.flips$color[comparison.flips$`Primary p-value` < comparison.flips$`Completers p-value`] = 1
rownames(comparison.flips) = NULL
kable(comparison.flips[,-4]) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal()  %>%
  row_spec(which(comparison.flips$color >0), color = "red") %>%
  row_spec(which(comparison.flips$color <1), color = "blue")
Outcome Primary p-value Completers p-value
Average Total Sugars 0.047 0.054
SRBAI Habit Strength 0.149 0.000
Frequency of Weighing Self 0.331 0.001
Talking Kindly to Self After Setback 0.140 0.030
Frequency of Fried Foods 0.073 0.034

Comparison Table

A table to compare model results between the primary, secondary complete case analysis, and three sensitivity analysis (outliers removed, LMM, bootstrap).

Let’s highlight the outcomes where primary p-value<0.05 and completers, outliers, or LMM p-value>0.05 (ignoring the Bootstrap p-values since none of the Bootstrap results that switch significance also violated the primary model assumptions).

We also highlighted the outcomes where primary p-value>0.05 and at least one of completers, outliers, or LMM p-value<0.05.

# Rename some columns for smooth merging:

# primary: primary_results
colnames(primary_results)[which(colnames(primary_results) == "p_value")] = "Primary P-value"

# complete case: completers_df
colnames(completers_df)[which(colnames(completers_df) == "diff_p")] = "Completers P-value"

# outliers removed: output_sens_saved
colnames(output_sens_saved)[which(colnames(output_sens_saved) == "p_value")] = "Outliers P-value"

# LMM: output_lmm_saved
colnames(output_lmm_saved)[which(colnames(output_lmm_saved) == "Outcomes")] = "Outcome"
colnames(output_lmm_saved)[which(colnames(output_lmm_saved) == "diff_p")] = "LMM P-value"

# Bootstrap: output_bootstrap
colnames(output_bootstrap)[which(colnames(output_bootstrap) == "p_value")] = "Bootstrap P-value"


# merging results into one:
comparison <- primary_results[,c("Outcome", "Outcome_label", "Primary P-value")] %>% # 52
  left_join(completers_df[,c("Outcome_label", "Completers P-value")], by = "Outcome_label") %>% # 83
  left_join(output_sens_saved[,c("Outcome_label", "Outliers P-value")], by = "Outcome_label") %>% # 83
  left_join(output_lmm_saved[,c("Outcome", "LMM P-value")], by = "Outcome") %>% # 79
  left_join(output_bootstrap[,c("Outcome_label", "Bootstrap P-value")], by = "Outcome_label") # 50

# format numeric
comparison_num <- comparison
comparison_num[,3:ncol(comparison_num)] = apply(comparison_num[,3:ncol(comparison_num)], 2, as.numeric)


# column names with spacing causing issues in dplyr so let's rename columns:
colnames(comparison_num) = c("Outcome",
                               "Outcome_label",
                               "Primary_pvalue",
                               "Completers_pvalue",
                               "Outliers_pvalue",
                               "LMM_pvalue",
                               "Bootstrap_pvalue")


# remove bootstrap from consideration and color by flips
comparison_num <- comparison_num %>% dplyr::group_by(Outcome) %>%
  dplyr::mutate(color = case_when(
    (Primary_pvalue < 0.05)  &
      max(Completers_pvalue, 
          Outliers_pvalue, 
          LMM_pvalue, na.rm = T) > 0.05 ~ 1,
    TRUE ~ 0
  ))
comparison_num <- comparison_num %>% dplyr::group_by(Outcome) %>%
  dplyr::mutate(color2 = case_when(
    (Primary_pvalue > 0.05)  &
      min(Completers_pvalue, 
          Outliers_pvalue, 
          LMM_pvalue, na.rm = T) < 0.05 ~ 1,
    TRUE ~ 0
  ))
#comparison.flips[,3:7] = round(comparison.flips[,3:7], 3)
comparison_num$Primary_pvalue = case_when(comparison_num$Primary_pvalue < 0.001 ~ sub(" ", "", format.pval(comparison_num$Primary_pvalue, eps = 0.001, digits = 3, nsmall=3)),TRUE ~ formatC(comparison_num$Primary_pvalue, digits = 3, format = "f"))
comparison_num$Completers_pvalue = case_when(comparison_num$Completers_pvalue < 0.001 ~ sub(" ", "", format.pval(comparison_num$Completers_pvalue, eps = 0.001, digits = 3, nsmall=3)),TRUE ~ formatC(comparison_num$Completers_pvalue, digits = 3, format = "f"))
comparison_num$Outliers_pvalue = case_when(comparison_num$Outliers_pvalue < 0.001 ~ sub(" ", "", format.pval(comparison_num$Outliers_pvalue, eps = 0.001, digits = 3, nsmall=3)),TRUE ~ formatC(comparison_num$Outliers_pvalue, digits = 3, format = "f"))
comparison_num$LMM_pvalue = case_when(comparison_num$LMM_pvalue < 0.001 ~ sub(" ", "", format.pval(comparison_num$LMM_pvalue, eps = 0.001, digits = 3, nsmall=3)),TRUE ~ formatC(comparison_num$LMM_pvalue, digits = 3, format = "f"))
comparison_num$Bootstrap_pvalue = case_when(comparison_num$Bootstrap_pvalue < 0.001 ~ sub(" ", "", format.pval(comparison_num$Bootstrap_pvalue, eps = 0.001, digits = 3, nsmall=3)),TRUE ~ formatC(comparison_num$Bootstrap_pvalue, digits = 3, format = "f"))

rownames(comparison_num) = NULL

kable(comparison_num[,-c(8,9)], 
      col.names = c("Variable", "Outcome", "Primary P-value", "Completers P-value", "Outliers P-value", "LMM P-value", "Bootstrap P-value")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% kable_minimal() %>%
  row_spec(which(comparison_num$color >0), color = "salmon") %>%
  row_spec(which(comparison_num$color2 >0), color = "blue") %>%
  pack_rows(index = c("Change ASA24 in HEI Diet Quality Scores" = 14,
                      "Other Dietary Quality Measures" = 1,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15))
Variable Outcome Primary P-value Completers P-value Outliers P-value LMM P-value Bootstrap P-value
Change ASA24 in HEI Diet Quality Scores
HEI2015_TOTAL_SCORE_change HEI Total Score <0.001 <0.001 <0.001 0.002 0.019
HEI2015C1_TOTALVEG_change Total Vegetable 0.365 0.359 0.357 0.425 0.840
HEI2015C2_GREEN_AND_BEAN_change Greens and Beans 0.002 0.001 0.002 0.027 0.919
HEI2015C3_TOTALFRUIT_change Total Fruit 0.006 0.007 0.006 0.007 0.167
HEI2015C4_WHOLEFRUIT_change Whole Fruit 0.018 0.018 0.018 0.028 0.911
HEI2015C5_WHOLEGRAIN_change Whole Grains 0.183 0.158 0.183 0.445 0.890
HEI2015C6_TOTALDAIRY_change Total Dairy 0.381 0.319 0.376 0.862 0.112
HEI2015C7_TOTPROT_change Total Protein Foods 0.738 0.560 0.762 0.490 NaN
HEI2015C8_SEAPLANT_PROT_change Seafood and Plant Proteins 0.510 0.481 0.518 0.889 0.996
HEI2015C9_FATTYACID_change Fatty Acids 0.460 0.368 0.469 0.399 0.327
HEI2015C10_SODIUM_change Sodium 0.400 0.373 0.406 0.924 0.756
HEI2015C11_REFINEDGRAIN_change Refined Grains 0.002 0.001 0.002 <0.001 0.212
HEI2015C12_SFAT_change Saturated Fats 0.083 0.082 0.085 0.133 0.219
HEI2015C13_ADDSUG_change Added Sugars 0.470 0.272 0.503 0.741 0.568
Other Dietary Quality Measures
amed_change AMED Score 0.196 0.243 0.195 0.433 0.625
Change in Micro and Macro Nutrients
KCAL_ave_change Average Total Energy <0.001 <0.001 <0.001 0.004 0.051
TFAT_ave_change Average Total Fat <0.001 <0.001 <0.001 0.003 0.021
CARB_ave_change Average Total Carbohydrates <0.001 <0.001 <0.001 0.010 <0.001
SODI_ave_change Average Sodium <0.001 <0.001 <0.001 0.006 0.185
SFAT_ave_change Average Saturated Fats <0.001 <0.001 <0.001 0.006 0.039
SUGR_ave_change Average Total Sugars 0.047 0.054 0.049 0.414 0.246
ADD_SUGARS_ave_change Average Added Sugars 0.019 0.017 0.021 0.169 0.084
CHOLE_ave_change Average Total Cholesterol 0.167 0.155 0.168 0.385 0.407
FIBE_ave_change Average Fiber 0.619 0.721 0.614 0.825 0.264
Weight Loss Measures
weightkg_change Body Weight (kg) <0.001 <0.001 <0.001 <0.001 <0.001
BMI_change BMI <0.001 <0.001 <0.001 <0.001 <0.001
changekg_percent_body_wt Percent Body Weight Change <0.001 <0.001 <0.001 NA <0.001
achieve_3_percent_wl Achieved 3% Weight Loss <0.001 <0.001 <0.001 NA NA
achieve_5_percent_wl Achieved 5% Weight Loss <0.001 <0.001 <0.001 NA NA
achieve_10_percent_wl Achieved 10% Weight Loss <0.001 <0.001 <0.001 NA NA
Change in Physical Activity
METS_change Total Physical Activity MET 0.767 0.938 0.757 0.808 0.681
sendentary_change Sedentary 0.118 0.121 0.138 0.084 0.016
moderate_change Moderate 0.715 0.902 0.729 0.886 0.620
vigorous_change Vigorous 0.983 0.872 0.971 0.858 0.991
Change Self-Reported Sleep
sleep_quality_change Sleep Quality 0.004 0.005 0.005 0.003 0.502
sleep_amount_change Usual Sleep Amount 0.014 0.016 0.014 0.018 0.998
wake_episodes_change Wake Episodes 0.837 0.800 0.832 0.937 0.755
Change in Habit Strength
SRBAI_change SRBAI Habit Strength 0.149 <0.001 0.149 <0.001 0.056
Avg1_change Considering Portion Sizes 0.020 0.003 0.021 0.008 0.964
Avg2_change Tracking Food Consumption 0.023 0.002 0.023 0.014 0.029
Avg3_change Consider WW Points <0.001 <0.001 <0.001 <0.001 <0.001
Avg4_change Frequency of Eating Vegetables 0.125 0.058 0.129 0.081 0.521
Avg5_change Frequency of Weighing Self 0.331 0.001 0.331 0.001 0.427
Avg6_change Frequency of Physical Activity 0.508 0.073 0.507 0.050 0.325
Avg7_change Talking Kindly to Self After Setback 0.140 0.030 0.141 0.005 0.050
Avg8_change Arranging Healthy Foods for Easy Access 0.026 <0.001 0.026 0.003 0.047
Avg9_change Frequency of Fried Foods 0.073 0.034 0.076 0.013 0.052
Avg10_change Frequency of Sweets <0.001 <0.001 <0.001 <0.001 <0.001
Avg11_change Frequency of Sugary Beverages 0.033 0.008 0.035 0.021 0.342
Avg12_change Snacking When Not Hungry 0.200 0.168 0.204 0.115 0.028
UnhSRBAI_change Unhealthy Grouped <0.001 <0.001 <0.001 <0.001 0.008
healSRBAI_change Healthy Grouped <0.001 <0.001 <0.001 <0.001 <0.001

Footnote: Four outcomes (HEI total protein, moderate activity, vigorous activity, and wake episodes) showed possible concerns for non-normality or unequal variance in the primary analysis model assumptions based on the criteria established above. Out of these four outcomes, results of significance tests between the primary analysis and Wilcox median bootstrap method remained consistent.

Tables for journal

These tables exist above in the report, but are rounded to one decimal except p-values that are rounded to three decimals without leading zero and Cohen’s D which is rounded to 2 decimals.

Table 1 one decimal

save_tab1 <- table1(~ Age_years + Sex_bcf + Gender_grouped + Race2_bcf + Ethnicity_bcf + Income_grouped + foodinsec+ Education_grouped + BMI_bl + HEI2015_TOTAL_SCORE_bl | Treatment, data = data_tab,
       render.continuous = for.cont.variables1)

save_tab1
Weight Watchers
(N=187)
Control
(N=189)
Overall
(N=376)
Age, years
Mean (SD) 47.6 (12.1) 47.9 (12.3) 47.7 (12.2)
Sex assigned at birth
Female 149 (79.7%) 149 (78.8%) 298 (79.3%)
Male 38 (20.3%) 40 (21.2%) 78 (20.7%)
Self-identified gender
Female 146 (78.1%) 147 (77.8%) 293 (77.9%)
Male 39 (20.9%) 41 (21.7%) 80 (21.3%)
Non-binary / third gender / Transgender 2 (1.1%) 1 (0.5%) 3 (0.8%)
Self-identified race
Asian 14 (7.5%) 14 (7.4%) 28 (7.4%)
Black or African-American 24 (12.8%) 28 (14.8%) 52 (13.8%)
White 139 (74.3%) 133 (70.4%) 272 (72.3%)
Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say 10 (5.3%) 14 (7.4%) 24 (6.4%)
Self-identified as Hispanic, Latinx, Latine, or Spanish
No 176 (94.1%) 164 (86.8%) 340 (90.4%)
Yes 11 (5.9%) 25 (13.2%) 36 (9.6%)
Household Income, USD
$59,999 or under 52 (27.8%) 47 (24.9%) 99 (26.3%)
Between $60,000 and $99,999 60 (32.1%) 63 (33.3%) 123 (32.7%)
$100,000 or above 75 (40.1%) 79 (41.8%) 154 (41.0%)
Food insecurity
No 125 (66.8%) 135 (71.4%) 260 (69.1%)
Yes 27 (14.4%) 40 (21.2%) 67 (17.8%)
Missing 35 (18.7%) 14 (7.4%) 49 (13.0%)
Highest level of education achieved
Associate degree or below 53 (28.3%) 63 (33.3%) 116 (30.9%)
Bachelor’s degree and some graduate school 72 (38.5%) 61 (32.3%) 133 (35.4%)
Masters or above 62 (33.2%) 65 (34.4%) 127 (33.8%)
BMI
Mean (SD) 33.6 (4.6) 33.6 (4.8) 33.6 (4.7)
Missing 1 (0.5%) 0 (0%) 1 (0.3%)
Diet quality, HEI-2015
Mean (SD) 55.3 (12.3) 55.2 (12.5) 55.3 (12.3)

Table 2 one decimal

save_tab2 <- datasummary(
  (`HEI Total Score` + 
    `Average Total Energy`+`Average Total Fat`+`Average Total Carbohydrates` +
     `Average Sodium` + `Average Saturated Fats` + `Average Total Sugars` + 
    `Average Added Sugars` +  `Average Total Cholesterol` + `Average Fiber` + 
     `Body Weight (kg)` + `BMI`
   )*Timepoint ~ Treatment * (N + Mean * Arguments(fmt = "%.1f") + SD * Arguments(fmt = "%.1f")),
  data = outcomes_tab_data_wide,
  output = 'data.frame'
)


# remove negative sign in instances of -0.0
save_tab2 <- change_negative_zero(save_tab2)


kable(save_tab2,
      caption = "Table 2") %>% 
  kable_styling()
Table 2
Timepoint Weight Watchers / N Weight Watchers / Mean Weight Watchers / SD Control / N Control / Mean Control / SD
HEI Total Score Baseline 187 55.3 12.3 189 55.2 12.5
Endline 160 59.4 12.7 181 55.2 13.0
Change 160 3.9 14.0 181 -0.1 13.0
Average Total Energy Baseline 187 1945.6 617.5 189 2047.1 725.1
Endline 160 1544.2 552.9 181 1809.6 668.8
Change 160 -424.5 623.8 181 -247.6 653.0
Average Total Fat Baseline 187 84.3 30.8 189 90.5 36.0
Endline 160 64.3 27.4 181 78.9 35.3
Change 160 -21.5 32.5 181 -11.5 35.1
Average Total Carbohydrates Baseline 187 208.1 81.9 189 215.4 85.6
Endline 160 162.5 70.2 181 189.4 80.4
Change 160 -47.0 80.0 181 -28.9 71.5
Average Sodium Baseline 187 3436.9 1130.9 189 3553.6 1393.2
Endline 160 2880.8 1042.0 181 3287.1 1163.2
Change 160 -583.8 1148.5 181 -268.9 1221.8
Average Saturated Fats Baseline 187 27.9 12.0 189 29.4 12.4
Endline 160 20.7 11.0 181 25.3 12.0
Change 160 -7.7 13.4 181 -4.2 13.1
Average Total Sugars Baseline 187 78.5 42.5 189 84.6 42.3
Endline 160 60.6 38.2 181 71.0 42.7
Change 160 -17.6 41.9 181 -14.8 40.6
Average Added Sugars Baseline 187 11.6 8.7 189 12.5 8.2
Endline 160 7.7 7.9 181 10.1 8.3
Change 160 -3.7 8.7 181 -2.7 8.6
Average Total Cholesterol Baseline 187 321.4 169.6 189 341.9 193.4
Endline 160 283.0 187.8 181 315.2 175.8
Change 160 -39.7 194.7 181 -22.0 188.3
Average Fiber Baseline 187 17.4 7.6 189 17.8 8.9
Endline 160 15.7 9.3 181 16.1 7.6
Change 160 -2.1 8.2 181 -1.9 7.6
Body Weight (kg) Baseline 186 94.6 17.1 189 95.0 16.9
Endline 153 90.3 17.7 177 93.7 17.7
Change 152 -5.5 7.0 177 -1.5 4.8
BMI Baseline 186 33.6 4.6 189 33.6 4.8
Endline 153 31.9 5.0 177 33.1 5.1
Change 152 -1.9 2.4 177 -0.5 1.7
save_etab2 <- datasummary(
  (  `Total Physical Activity MET`+`Sedentary`+`Moderate`+`Vigorous` +
       
         `Sleep Quality`+`Usual Sleep Amount`+`Wake Episodes`
     +`SRBAI Habit Strength` + `Considering Portion Sizes` + `Tracking Food Consumption`+`Consider WW Points`+
     `Frequency of Eating Vegetables`+`Frequency of Weighing Self`+`Frequency of Physical Activity`+
     `Talking Kindly to Self After Setback`+`Arranging Healthy Foods for Easy Access`+`Frequency of Fried Foods`+
     `Frequency of Sweets`+`Frequency of Sugary Beverages`+ `Snacking When Not Hungry`+`Unhealthy Grouped`+`Healthy Grouped`
   )*Timepoint ~ Treatment * (N + Mean * Arguments(fmt = "%.1f") + SD * Arguments(fmt = "%.1f")),
  data = outcomes_tab_data_wide,
  output = 'data.frame'
)


# remove negative sign in instances of -0.0
save_etab2 <- change_negative_zero(save_etab2)

kable(save_etab2,
      caption = "eTable 2") %>% 
  kable_styling()
eTable 2
Timepoint Weight Watchers / N Weight Watchers / Mean Weight Watchers / SD Control / N Control / Mean Control / SD
Total Physical Activity MET Baseline 187 1849.6 2948.5 189 1678.2 2434.5
Endline 152 2368.0 3114.0 175 2265.5 3084.3
Change 152 488.6 2688.1 175 568.9 2794.9
Sedentary Baseline 187 495.2 230.8 189 492.7 228.3
Endline 152 428.0 205.0 175 453.5 228.0
Change 152 -70.7 212.7 175 -32.8 191.7
Moderate Baseline 187 1110.1 1662.1 189 1047.9 1852.4
Endline 152 1335.8 1931.0 175 1262.6 1624.5
Change 152 150.9 1975.1 175 198.8 1912.7
Vigorous Baseline 187 739.5 2095.5 189 630.3 1205.3
Endline 152 1032.2 1905.3 175 1002.8 2093.0
Change 152 337.7 1891.3 175 370.1 1662.0
Sleep Quality Baseline 187 2.4 0.8 189 2.4 0.7
Endline 160 2.3 0.9 181 2.6 0.8
Change 160 -0.1 0.7 181 0.2 0.8
Usual Sleep Amount Baseline 187 2.0 0.3 189 2.0 0.3
Endline 160 2.0 0.4 181 2.1 0.4
Change 160 -0.1 0.4 181 0.1 0.4
Wake Episodes Baseline 187 1.3 1.1 189 1.3 1.2
Endline 157 1.3 1.3 179 1.3 1.3
Change 157 0.0 1.3 179 0.0 1.1
SRBAI Habit Strength Baseline 187 3.3 0.9 189 3.3 0.8
Endline 152 4.1 0.8 175 3.6 0.9
Change 152 0.8 0.9 175 0.3 0.8
Considering Portion Sizes Baseline 187 3.7 1.8 189 3.8 1.7
Endline 152 4.9 1.5 175 4.4 1.6
Change 152 1.1 1.9 175 0.7 1.8
Tracking Food Consumption Baseline 187 2.1 1.6 189 2.0 1.7
Endline 152 3.4 1.8 175 2.7 1.9
Change 152 1.3 2.0 175 0.8 2.0
Consider WW Points Baseline 187 0.6 1.3 189 0.7 1.4
Endline 152 3.9 2.0 175 1.5 2.0
Change 152 3.3 2.3 175 0.7 1.7
Frequency of Eating Vegetables Baseline 187 4.8 1.6 189 4.8 1.7
Endline 152 5.3 1.4 175 5.1 1.7
Change 152 0.6 1.7 175 0.3 1.5
Frequency of Weighing Self Baseline 187 3.3 2.0 189 3.3 2.1
Endline 152 4.3 1.9 175 3.8 2.1
Change 152 1.0 1.8 175 0.4 1.9
Frequency of Physical Activity Baseline 187 3.6 1.7 189 3.6 1.8
Endline 152 4.3 1.7 175 4.0 1.8
Change 152 0.7 1.6 175 0.4 1.6
Talking Kindly to Self After Setback Baseline 187 3.0 1.9 189 3.4 2.0
Endline 152 3.7 1.8 175 3.5 2.0
Change 152 0.7 1.7 175 0.2 1.9
Arranging Healthy Foods for Easy Access Baseline 187 3.1 2.2 189 3.2 2.2
Endline 152 4.2 1.9 175 3.6 2.1
Change 152 1.0 2.5 175 0.5 2.1
Frequency of Fried Foods Baseline 187 3.5 1.9 189 3.4 1.9
Endline 152 2.8 1.9 175 3.1 1.9
Change 152 -0.7 1.8 175 -0.3 1.7
Frequency of Sweets Baseline 187 4.6 1.8 189 4.5 1.9
Endline 152 3.2 1.9 175 4.0 1.9
Change 152 -1.3 2.0 175 -0.5 1.9
Frequency of Sugary Beverages Baseline 187 2.4 2.3 189 2.5 2.4
Endline 152 1.5 1.9 175 2.1 2.3
Change 152 -0.8 1.8 175 -0.4 1.9
Snacking When Not Hungry Baseline 187 4.6 1.9 189 4.5 1.9
Endline 152 3.8 1.8 175 4.0 2.0
Change 152 -0.8 1.7 175 -0.5 2.1
Unhealthy Grouped Baseline 187 3.8 1.4 189 3.7 1.4
Endline 152 2.8 1.4 175 3.3 1.4
Change 152 -0.9 1.3 175 -0.4 1.3
Healthy Grouped Baseline 187 3.0 1.0 189 3.1 1.0
Endline 152 4.3 1.0 175 3.6 1.1
Change 152 1.2 1.1 175 0.5 1.0

Table 3 one decimal

# Re-round p-values for journal submission:
output3 <- primary_results

rownames(output3) = NULL
output3[,3:ncol(output3)] = apply(output3[,3:ncol(output3)], 2, as.numeric)

# Combine Mean (SE) and format p-values
table3 <- output3 %>% dplyr::select(Outcome_label, Mean1, SE1, Mean2, SE2, Mean_Diff, SE_Diff, Mean_Diff_LB, Mean_Diff_UB, `Primary P-value`, Cohens_d_unadjusted) %>%
  dplyr::rename(p_value = `Primary P-value`) %>%
  reframe(Outcome = Outcome_label, 
          WW = paste0(formatC(Mean1, digits = 1, format = "f"), " (", formatC(SE1, digits = 1, format = "f"),  ")"),
          Control = paste0(formatC(Mean2, digits = 1, format = "f"), " (", formatC(SE2, digits = 1, format = "f"),  ")"),
          Diff = paste0(formatC(Mean_Diff, digits = 1, format = "f"), " (", formatC(SE_Diff, digits = 1, format = "f"),  ")"),
          Diff_CI = paste0("(", formatC(Mean_Diff_LB, digits = 1, format = "f"), ", ", 
                           formatC(Mean_Diff_UB, digits = 1, format = "f"), ")"),
          p_value_journal = case_when(
            p_value < 0.001 ~ "<.001",
            p_value > 0.001 & p_value < 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value >= 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value > 0.99 ~ ">.99"),
          Cohens_d = formatC(Cohens_d_unadjusted, digits = 2, format = "f") 
  )


table3_n <- unique(output3$`Number of Participants`)

# reorder for grouping
table3 <- table3[match(outcome_pairs$outcome_labels, table3$Outcome), ]
rownames(table3) <- NULL

# let's identify 3 binary outcomes
table3$Outcome[grep("Achieved", table3$Outcome)] = paste0(table3$Outcome[grep("Achieved", table3$Outcome)], "*")


# remove negative sign in instances of -0.0
table3 <- change_negative_zero(table3)


# export to excel
save_tab3 <- table3[c(1,16:24,25:30),]
save_tab3$Cohens_d <- formatC(save_tab3$Cohens_d, digits = 2, format = "f") # to preserve digits
colnames(save_tab3) <- c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", "95% CI of Mean Difference",  
                    "p-value", "Cohen's d")

rownames(save_tab3) = NULL
kable(save_tab3,
      caption = "Table 3 Analysis Results (ANCOVA with MI, N=376)", 
      col.names = c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", "95% CI of Mean Difference",  
                    "p-value", "Cohen's d")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() 
Table 3 Analysis Results (ANCOVA with MI, N=376)
Outcome WW Mean (SE) Control Mean (SE) Mean Difference (SE) 95% CI of Mean Difference p-value Cohen’s d
HEI Total Score 5.3 (1.5) 1.1 (1.4) 4.2 (1.2) (1.8, 6.6) <.001 0.30
Average Total Energy -468.2 (70.0) -241.8 (63.8) -226.4 (56.2) (-336.9, -116.0) <.001 -0.28
Average Total Fat -22.3 (3.7) -9.9 (3.4) -12.4 (3.0) (-18.3, -6.5) <.001 -0.27
Average Total Carbohydrates -50.5 (8.5) -26.8 (7.7) -23.7 (6.8) (-37.2, -10.2) <.001 -0.27
Average Sodium -550.0 (128.9) -180.1 (116.2) -369.8 (103.6) (-573.8, -165.9) <.001 -0.27
Average Saturated Fats -8.4 (1.4) -4.2 (1.3) -4.2 (1.1) (-6.5, -2.0) <.001 -0.25
Average Total Sugars -25.3 (4.7) -17.8 (4.3) -7.5 (3.8) (-14.9, -0.1) .047 -0.10
Average Added Sugars -5.0 (1.0) -3.2 (0.9) -1.8 (0.8) (-3.4, -0.3) .019 -0.15
Average Total Cholesterol -48.8 (22.8) -23.5 (20.2) -25.3 (18.2) (-61.2, 10.6) .167 0.07
Average Fiber -1.9 (1.0) -1.5 (0.9) -0.4 (0.8) (-1.9, 1.1) .619 0.03
Body Weight (kg) -5.4 (0.9) -1.6 (0.8) -3.9 (0.7) (-5.3, -2.5) <.001 -0.61
BMI -1.9 (0.3) -0.5 (0.3) -1.3 (0.2) (-1.8, -0.8) <.001 -0.61
Percent Body Weight Change -5.4 (0.9) -1.5 (0.8) -3.9 (0.7) (-5.4, -2.5) <.001 -0.61
Achieved 3% Weight Loss* 0.6 (0.1) 0.3 (0.1) 2.7 (0.6) (1.7, 4.3) <.001 0.48
Achieved 5% Weight Loss* 0.5 (0.1) 0.2 (0.0) 3.3 (0.8) (2.1, 5.4) <.001 0.58
Achieved 10% Weight Loss* 0.2 (0.1) 0.0 (0.0) 7.1 (2.9) (3.2, 15.8) <.001 0.62

Sample size for the above table is 376 participants.

save_etab3 <- table3[c(2:14,31:34,35:37,38:52),]
colnames(save_etab3) <- c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)",  "95% CI of Mean Difference",  
                    "p-value", "Cohen's d")
save_etab3 <- rbind(c("Healthy-Eating Index subscales)", "", "", "", "", "", ""),
                   save_etab3[1:13,],
                   c("Change in Physical Activity", "", "", "", "", "", ""),
                   save_etab3[14:17,],
                   c("Change Self-Reported Sleep", "", "", "", "", "", ""),
                   save_etab3[18:20,],
                   c("Change in Habit Strength", "", "", "", "", "", ""),
                   save_etab3[21:35,]
                   )

rownames(save_etab3) = NULL

kable(save_etab3,
      caption = "eTable 3 Analysis Results (ANCOVA with MI)", 
      col.names = c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                     "95% CI of Mean Difference",  
                    "p-value", "Cohen's d")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() 
eTable 3 Analysis Results (ANCOVA with MI)
Outcome WW Mean (SE) Control Mean (SE) Mean Difference (SE) 95% CI of Mean Difference p-value Cohen’s d
Healthy-Eating Index subscales)
Total Vegetable 0.2 (0.2) 0.1 (0.2) 0.1 (0.1) (-0.1, 0.4) .365 0.08
Greens and Beans 0.9 (0.3) 0.2 (0.3) 0.7 (0.2) (0.3, 1.2) .002 0.21
Total Fruit 0.5 (0.2) 0.0 (0.2) 0.5 (0.2) (0.2, 0.9) .006 0.27
Whole Fruit 0.1 (0.3) -0.4 (0.2) 0.5 (0.2) (0.1, 0.9) .018 0.22
Whole Grains 1.1 (0.4) 0.6 (0.4) 0.5 (0.4) (-0.2, 1.2) .183 0.07
Total Dairy -0.5 (0.4) -0.2 (0.4) -0.3 (0.3) (-0.9, 0.3) .381 0.02
Total Protein Foods 0.1 (0.1) 0.1 (0.1) 0.0 (0.1) (-0.1, 0.2) .738 0.05
Seafood and Plant Proteins 0.2 (0.3) 0.1 (0.2) 0.1 (0.2) (-0.3, 0.6) .510 0.01
Fatty Acids 1.2 (0.5) 0.9 (0.4) 0.3 (0.4) (-0.4, 1.0) .460 0.08
Sodium -1.1 (0.4) -0.8 (0.3) -0.2 (0.3) (-0.8, 0.3) .400 0.01
Refined Grains 0.5 (0.4) -0.6 (0.4) 1.1 (0.4) (0.4, 1.8) .002 0.33
Saturated Fats 1.5 (0.5) 0.9 (0.4) 0.6 (0.4) (-0.1, 1.3) .083 0.14
Added Sugars 0.6 (0.3) 0.4 (0.3) 0.2 (0.2) (-0.3, 0.6) .470 0.02
Change in Physical Activity
Total Physical Activity MET 672.3 (337.6) 750.9 (306.6) -78.6 (265.5) (-600.9, 443.7) .767 0.05
Sedentary -70.2 (26.2) -37.3 (23.3) -32.9 (20.9) (-74.2, 8.4) .118 -0.15
Moderate 232.0 (211.3) 293.3 (191.9) -61.3 (168.0) (-391.9, 269.2) .715 0.04
Vigorous 511.8 (227.5) 515.6 (205.4) -3.9 (180.7) (-359.3, 351.6) .983 0.03
Change Self-Reported Sleep
Sleep Quality 0.0 (0.1) 0.2 (0.1) -0.2 (0.1) (-0.4, -0.1) .004 -0.30
Usual Sleep Amount -0.1 (0.1) 0.0 (0.0) -0.1 (0.0) (-0.2, 0.0) .014 -0.23
Wake Episodes 0.0 (0.2) 0.0 (0.1) 0.0 (0.1) (-0.2, 0.3) .837 0.01
Change in Habit Strength
SRBAI Habit Strength 0.9 (0.3) 0.4 (0.1) 0.5 (0.3) (-0.2, 1.1) .149 0.48
Considering Portion Sizes 1.1 (0.3) 0.7 (0.2) 0.5 (0.2) (0.1, 0.9) .020 0.25
Tracking Food Consumption 1.5 (0.3) 0.9 (0.3) 0.5 (0.2) (0.1, 1.0) .023 0.22
Consider WW Points 3.7 (0.3) 1.0 (0.2) 2.6 (0.2) (2.2, 3.1) <.001 1.28
Frequency of Eating Vegetables 0.7 (0.2) 0.4 (0.2) 0.3 (0.2) (-0.1, 0.6) .125 0.15
Frequency of Weighing Self 1.1 (0.7) 0.4 (0.2) 0.7 (0.7) (-0.7, 2.1) .331 0.31
Frequency of Physical Activity 0.6 (0.6) 0.2 (0.2) 0.4 (0.6) (-0.8, 1.6) .508 0.22
Talking Kindly to Self After Setback 0.8 (0.3) 0.4 (0.2) 0.3 (0.2) (-0.1, 0.7) .140 0.24
Arranging Healthy Foods for Easy Access 1.2 (0.3) 0.7 (0.2) 0.5 (0.2) (0.1, 1.0) .026 0.23
Frequency of Fried Foods -0.5 (0.3) -0.2 (0.2) -0.4 (0.2) (-0.8, 0.0) .073 -0.23
Frequency of Sweets -1.5 (0.3) -0.7 (0.2) -0.8 (0.2) (-1.2, -0.4) <.001 -0.40
Frequency of Sugary Beverages -0.8 (0.2) -0.4 (0.2) -0.4 (0.2) (-0.8, 0.0) .033 -0.21
Snacking When Not Hungry -0.7 (0.2) -0.5 (0.2) -0.2 (0.2) (-0.6, 0.1) .200 -0.15
Unhealthy Grouped -0.9 (0.2) -0.4 (0.1) -0.4 (0.1) (-0.7, -0.2) <.001 -0.37
Healthy Grouped 1.3 (0.1) 0.6 (0.1) 0.7 (0.1) (0.5, 0.9) <.001 0.73

\(^*\) These are binary outcomes with probabilities for group means and OR for mean difference.

Sample size for the above table is 376 participants.

Complete-Case one decimal

ANCOVA on complete-case data

completers_df3 <- completers_df
rownames(completers_df3) = NULL

# Combine Mean (SE) and format p-values
supp1 <- completers_df3 %>% dplyr::select(Outcome_label, n, group1_mean, group1_se, group2_mean, group2_se, diff_mean, diff_se, diff_LB, diff_UB, `Completers P-value`, Cohens_d) %>%
  dplyr::rename(diff_p = `Completers P-value`) %>%
  reframe(Outcome = Outcome_label, 
          N = n,
          WW = paste0(formatC(group1_mean, digits = 1, format = "f"), " (", formatC(group1_se, digits = 1, format = "f"),  ")"),
          Control = paste0(formatC(group2_mean, digits = 1, format = "f"), " (", formatC(group2_se, digits = 1, format = "f"),  ")"),
          Diff = paste0(formatC(diff_mean, digits = 1, format = "f"), " (", formatC(diff_se, digits = 1, format = "f"),  ")"),
          diff_CI = paste0("(", formatC(diff_LB, digits = 1, format = "f"), ", ", 
                           formatC(diff_UB, digits = 1, format = "f"), ")"),
          p_value_journal = case_when(
            diff_p < 0.001 ~ "<.001",
            diff_p > 0.001 & diff_p < 0.01 ~ leading_zeros( formatC(diff_p, digits = 3, format = "f") ),
            diff_p >= 0.01 ~ leading_zeros( formatC(diff_p, digits = 3, format = "f") ),
            diff_p > 0.99 ~ ">.99"),
          Cohens_d = formatC(Cohens_d, digits = 2, format = "f")
  )

# reorder for grouping
supp1 <- supp1[match(outcome_pairs$outcome_labels, supp1$Outcome), ]

# remove negative sign in instances of -0.0
supp1 <- change_negative_zero(supp1)

rownames(supp1) <- NULL

# let's identify 3 binary outcomes
supp1$Outcome[grep("Achieved", supp1$Outcome)] = paste0(supp1$Outcome[grep("Achieved", supp1$Outcome)], "*")


kable(supp1,
      caption = "Supplemental Table: Sensitivity Complete-Case Analysis", 
      col.names = c("Outcome", "N", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value", "Cohen's d")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() %>%
  add_header_above(c(" " = 2,  "Sensitivity Analysis (Complete-Case)" = 6)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15)) 
Supplemental Table: Sensitivity Complete-Case Analysis
Sensitivity Analysis (Complete-Case)
Outcome N WW Mean (SE) Control Mean (SE) Mean Difference (SE) 95% CI of Mean Difference p-value Cohen’s d
Change in Dietary Quality Measures (including HEI subscores)
HEI Total Score 341 5.3 (1.5) 1.2 (1.4) 4.1 (1.2) (1.7, 6.5) <.001 0.37
Total Vegetable 341 0.2 (0.2) 0.1 (0.1) 0.1 (0.1) (-0.1, 0.4) .359 0.10
Greens and Beans 341 0.9 (0.3) 0.3 (0.2) 0.7 (0.2) (0.3, 1.1) .001 0.36
Total Fruit 341 0.4 (0.2) -0.1 (0.2) 0.5 (0.2) (0.1, 0.9) .007 0.30
Whole Fruit 341 0.1 (0.3) -0.4 (0.2) 0.5 (0.2) (0.1, 0.9) .018 0.26
Whole Grains 341 1.0 (0.4) 0.5 (0.4) 0.5 (0.3) (-0.2, 1.2) .158 0.16
Total Dairy 341 -0.6 (0.4) -0.3 (0.3) -0.3 (0.3) (-0.9, 0.3) .319 -0.11
Total Protein Foods 341 0.1 (0.1) 0.1 (0.1) 0.0 (0.1) (-0.1, 0.2) .560 0.06
Seafood and Plant Proteins 341 0.3 (0.3) 0.1 (0.2) 0.1 (0.2) (-0.3, 0.6) .481 0.08
Fatty Acids 341 1.4 (0.4) 1.1 (0.4) 0.3 (0.3) (-0.4, 1.0) .368 0.10
Sodium 341 -1.2 (0.4) -0.9 (0.3) -0.2 (0.3) (-0.8, 0.3) .373 -0.10
Refined Grains 341 0.5 (0.4) -0.6 (0.4) 1.1 (0.3) (0.4, 1.7) .001 0.35
Saturated Fats 341 1.6 (0.4) 1.0 (0.4) 0.6 (0.3) (-0.1, 1.3) .082 0.19
Added Sugars 341 0.6 (0.3) 0.4 (0.2) 0.2 (0.2) (-0.2, 0.7) .272 0.12
AMED Score 341 0.8 (0.6) 0.2 (0.6) 0.6 (0.5) (-0.4, 1.6) .243 0.13
Change in Micro and Macro Nutrients
Average Total Energy 341 -466.3 (73.2) -233.4 (66.0) -233.0 (58.6) (-348.2, -117.8) <.001 -0.44
Average Total Fat 341 -22.6 (3.9) -9.7 (3.5) -12.9 (3.1) (-19.1, -6.8) <.001 -0.46
Average Total Carbohydrates 341 -48.9 (8.7) -25.4 (7.9) -23.5 (7.0) (-37.2, -9.8) <.001 -0.37
Average Sodium 341 -520.2 (132.3) -161.1 (119.2) -359.1 (105.2) (-565.9, -152.2) <.001 -0.38
Average Saturated Fats 341 -8.5 (1.5) -4.2 (1.3) -4.3 (1.2) (-6.6, -2.0) <.001 -0.40
Average Total Sugars 341 -24.3 (4.8) -16.8 (4.3) -7.5 (3.9) (-15.1, 0.1) .054 -0.21
Average Added Sugars 341 -5.0 (1.0) -3.1 (0.9) -1.9 (0.8) (-3.5, -0.3) .017 -0.26
Average Total Cholesterol 341 -50.8 (22.6) -25.1 (20.3) -25.7 (18.0) (-61.2, 9.8) .155 -0.16
Average Fiber 341 -1.6 (0.9) -1.4 (0.8) -0.3 (0.8) (-1.8, 1.2) .721 0.04
Weight Loss Measures
Body Weight (kg) 329 -5.7 (0.8) -1.7 (0.7) -4.0 (0.7) (-5.2, -2.6) <.001 -0.67
BMI 329 -2.0 (0.3) -0.6 (0.2) -1.4 (0.2) (-1.8, -0.9) <.001 -0.68
Percent Body Weight Change 329 -5.7 (0.8) -1.8 (0.8) -4.0 (0.7) (-5.3, -2.7) <.001 -0.67
Achieved 3% Weight Loss* 329 0.6 (0.1) 0.3 (0.1) 3.0 (0.7) (1.9, 4.8) <.001 NA
Achieved 5% Weight Loss* 329 0.5 (0.1) 0.2 (0.1) 3.8 (0.9) (2.3, 6.1) <.001 NA
Achieved 10% Weight Loss* 329 0.2 (0.1) 0.0 (0.0) 6.6 (2.7) (2.9, 14.9) <.001 NA
Change in Physical Activity
Total Physical Activity MET 327 843.5 (366.8) 821.1 (326.3) 22.5 (289.2) (-546.5, 591.5) .938 0.01
Sedentary 327 -72.6 (25.1) -41.7 (22.5) -30.9 (19.9) (-69.9, 8.2) .121 -0.18
Moderate 327 323.2 (226.5) 301.0 (201.7) 22.2 (179.1) (-330.3, 374.6) .902 0.01
Vigorous 327 615.0 (245.4) 583.6 (218.8) 31.4 (194.2) (-350.6, 413.5) .872 0.02
Change Self-Reported Sleep
Sleep Quality 341 0.0 (0.1) 0.2 (0.1) -0.2 (0.1) (-0.4, -0.1) .005 -0.31
Usual Sleep Amount 341 -0.1 (0.1) 0.0 (0.0) -0.1 (0.0) (-0.2, 0.0) .016 -0.27
Wake Episodes 336 0.0 (0.1) 0.0 (0.1) 0.0 (0.1) (-0.2, 0.3) .800 0.03
Change in Habit Strength
SRBAI Habit Strength 327 0.9 (0.1) 0.4 (0.1) 0.5 (0.1) (0.4, 0.7) <.001 0.70
Considering Portion Sizes 327 1.1 (0.2) 0.6 (0.2) 0.5 (0.2) (0.2, 0.8) .003 0.34
Tracking Food Consumption 327 1.6 (0.2) 0.9 (0.2) 0.6 (0.2) (0.2, 1.0) .002 0.35
Consider WW Points 327 3.7 (0.3) 1.1 (0.2) 2.6 (0.2) (2.2, 3.0) <.001 1.41
Frequency of Eating Vegetables 327 0.7 (0.2) 0.4 (0.2) 0.3 (0.1) (0.0, 0.6) .058 0.21
Frequency of Weighing Self 327 1.0 (0.2) 0.5 (0.2) 0.6 (0.2) (0.2, 0.9) .001 0.37
Frequency of Physical Activity 327 0.5 (0.2) 0.2 (0.2) 0.3 (0.2) (0.0, 0.6) .073 0.20
Talking Kindly to Self After Setback 327 0.9 (0.2) 0.5 (0.2) 0.4 (0.2) (0.0, 0.7) .030 0.25
Arranging Healthy Foods for Easy Access 327 1.4 (0.3) 0.7 (0.2) 0.7 (0.2) (0.3, 1.1) <.001 0.38
Frequency of Fried Foods 327 -0.5 (0.2) -0.1 (0.2) -0.4 (0.2) (-0.7, 0.0) .034 -0.24
Frequency of Sweets 327 -1.5 (0.2) -0.7 (0.2) -0.8 (0.2) (-1.1, -0.4) <.001 -0.46
Frequency of Sugary Beverages 327 -0.7 (0.2) -0.3 (0.2) -0.5 (0.2) (-0.8, -0.1) .008 -0.30
Snacking When Not Hungry 327 -0.8 (0.2) -0.6 (0.2) -0.3 (0.2) (-0.6, 0.1) .168 -0.16
Unhealthy Grouped 327 -0.9 (0.2) -0.4 (0.1) -0.5 (0.1) (-0.7, -0.2) <.001 -0.41
Healthy Grouped 327 1.3 (0.1) 0.6 (0.1) 0.7 (0.1) (0.5, 0.9) <.001 0.82
# export to excel
save_etab4 <- supp1[-c(15),]
colnames(save_etab4) <- c("Outcome", "N", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value", "Cohen's d")
save_etab4 <- rbind(c("Change in Dietary Quality Measures (including HEI subscores)", "","", "", "", "", "", ""),
                   save_etab4[1:14,],
                   c("Change in Micro and Macro Nutrients","", "", "", "", "", "", ""),
                   save_etab4[15:23,],
                   c("Weight Loss Measures","", "", "", "", "", "", ""),
                   save_etab4[24:29,],
                   c("Change in Physical Activity","", "", "", "", "", "", ""),
                   save_etab4[30:33,],
                   c("Change Self-Reported Sleep","", "", "", "", "", "", ""),
                   save_etab4[34:36,],
                   c("Change in Habit Strength","", "", "", "", "", "", ""),
                   save_etab4[37:51,]
                   )

\(^*\) These are binary outcomes with probabilities for group means and OR for mean difference.

LMM one decimal

LMM on all study participants.

# Combine Mean (SE) and format p-values
table_lmm_one <- output_lmm_raw %>% dplyr::select(outcome_labels, group1_mean, group1_se, group2_mean, group2_se, diff_mean, 
                                                  diff_LB, diff_UB, diff_se, diff_p) %>%
  dplyr::rename(p_value = diff_p) %>%
  reframe(Outcome = outcome_labels, 
          WW = paste0(formatC(group1_mean, digits = 1, format = "f"), " (", 
                      formatC(group1_se, digits = 1, format = "f"),  ")"),
          Control = paste0(formatC(group2_mean, digits = 1, format = "f"), " (", 
                           formatC(group2_se, digits = 1, format = "f"),  ")"),
          Diff = paste0(formatC(diff_mean, digits = 1, format = "f"), " (", 
                        formatC(diff_se, digits = 1, format = "f"),  ")"),
          diff_CI = paste0("(", formatC(diff_LB, digits = 1, format = "f"), ", ", 
                           formatC(diff_UB, digits = 1, format = "f"), ")"),
          p_value_journal = case_when(
            p_value < 0.001 ~ "<.001",
            p_value > 0.001 & p_value < 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value >= 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value > 0.99 ~ ">.99")
  )

# reorder for grouping
table_lmm_one <- table_lmm_one[match(setdiff(outcome_pairs$outcome_labels, c("Percent Body Weight Change", "Achieved 3% Weight Loss", "Achieved 5% Weight Loss", "Achieved 10% Weight Loss")), table_lmm_one$Outcome), ]

# remove negative sign in instances of -0.0
table_lmm_one <- change_negative_zero(table_lmm_one)

rownames(table_lmm_one) <- NULL

kable(table_lmm_one,
      caption = "Sensitivity LMM Analysis (N=376)", 
      col.names = c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() %>%
  add_header_above(c(" " = 1,  "Sensitivity Analysis (LMM)" = 5)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6-4,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15))
Sensitivity LMM Analysis (N=376)
Sensitivity Analysis (LMM)
Outcome WW Mean (SE) Control Mean (SE) Mean Difference (SE) 95% CI of Mean Difference p-value
Change in Dietary Quality Measures (including HEI subscores)
HEI Total Score 3.9 (0.9) -0.1 (0.9) 4.0 (1.3) (1.4, 6.5) .002
Total Vegetable 0.2 (0.1) 0.1 (0.1) 0.1 (0.1) (-0.2, 0.4) .425
Greens and Beans 0.5 (0.2) 0.0 (0.2) 0.5 (0.2) (0.1, 1.0) .027
Total Fruit 0.5 (0.1) 0.0 (0.1) 0.5 (0.2) (0.1, 0.9) .007
Whole Fruit 0.4 (0.2) -0.1 (0.1) 0.5 (0.2) (0.1, 0.9) .028
Whole Grains 0.3 (0.3) 0.0 (0.3) 0.3 (0.4) (-0.4, 1.0) .445
Total Dairy -0.2 (0.2) -0.1 (0.2) -0.1 (0.3) (-0.7, 0.6) .862
Total Protein Foods 0.1 (0.1) 0.1 (0.1) 0.1 (0.1) (-0.1, 0.2) .490
Seafood and Plant Proteins -0.2 (0.2) -0.2 (0.2) 0.0 (0.2) (-0.5, 0.4) .889
Fatty Acids 0.6 (0.3) 0.3 (0.3) 0.3 (0.4) (-0.4, 1.0) .399
Sodium -0.6 (0.2) -0.6 (0.2) 0.0 (0.3) (-0.6, 0.6) .924
Refined Grains 0.8 (0.3) -0.5 (0.3) 1.2 (0.4) (0.5, 2.0) <.001
Saturated Fats 1.1 (0.3) 0.5 (0.2) 0.5 (0.4) (-0.2, 1.2) .133
Added Sugars 0.4 (0.2) 0.4 (0.2) 0.1 (0.2) (-0.4, 0.5) .741
AMED Score -0.1 (0.4) -0.5 (0.4) 0.4 (0.5) (-0.6, 1.5) .433
Change in Micro and Macro Nutrients
Average Total Energy -420.2 (43.9) -244.4 (42.4) -175.7 (61.1) (-295.8, -55.7) .004
Average Total Fat -21.2 (2.3) -11.6 (2.2) -9.7 (3.2) (-16.1, -3.3) .003
Average Total Carbohydrates -46.8 (5.2) -28.1 (5.0) -18.7 (7.3) (-32.9, -4.4) .010
Average Sodium -577.7 (80.6) -267.6 (77.8) -310.0 (112.0) (-530.3, -89.7) .006
Average Saturated Fats -7.6 (0.9) -4.1 (0.9) -3.4 (1.3) (-5.9, -1.0) .006
Average Total Sugars -17.7 (2.9) -14.5 (2.8) -3.3 (4.0) (-11.1, 4.6) .414
Average Added Sugars -3.8 (0.6) -2.6 (0.6) -1.1 (0.8) (-2.8, 0.5) .169
Average Total Cholesterol -39.5 (13.3) -23.4 (12.8) -16.1 (18.5) (-52.5, 20.3) .385
Average Fiber -2.1 (0.6) -1.9 (0.5) -0.2 (0.8) (-1.7, 1.3) .825
Weight Loss Measures
Body Weight (kg) -5.4 (0.4) -1.5 (0.4) -4.0 (0.6) (-5.2, -2.8) <.001
BMI -1.9 (0.2) -0.5 (0.1) -1.4 (0.2) (-1.8, -1.0) <.001
Change in Physical Activity
Total Physical Activity MET 497.7 (199.1) 564.6 (191.0) -66.9 (275.9) (-609.5, 475.6) .808
Sedentary -68.2 (14.3) -33.9 (13.7) -34.3 (19.8) (-73.2, 4.6) .084
Moderate 177.5 (133.1) 203.9 (127.7) -26.4 (184.4) (-389.1, 336.3) .886
Vigorous 329.5 (131.0) 362.1 (125.6) -32.6 (181.5) (-389.4, 324.3) .858
Change Self-Reported Sleep
Sleep Quality -0.1 (0.1) 0.2 (0.1) -0.2 (0.1) (-0.4, -0.1) .003
Usual Sleep Amount 0.0 (0.0) 0.1 (0.0) -0.1 (0.0) (-0.2, 0.0) .018
Wake Episodes 0.0 (0.1) 0.0 (0.1) 0.0 (0.1) (-0.2, 0.2) .937
Change in Habit Strength
SRBAI Habit Strength 0.8 (0.1) 0.3 (0.1) 0.5 (0.1) (0.4, 0.7) <.001
Considering Portion Sizes 1.1 (0.1) 0.7 (0.1) 0.5 (0.2) (0.1, 0.8) .008
Tracking Food Consumption 1.3 (0.1) 0.8 (0.1) 0.5 (0.2) (0.1, 0.9) .014
Consider WW Points 3.3 (0.1) 0.7 (0.1) 2.6 (0.2) (2.2, 3.0) <.001
Frequency of Eating Vegetables 0.6 (0.1) 0.3 (0.1) 0.3 (0.2) (0.0, 0.6) .081
Frequency of Weighing Self 1.0 (0.1) 0.4 (0.1) 0.6 (0.2) (0.2, 0.9) .001
Frequency of Physical Activity 0.7 (0.1) 0.4 (0.1) 0.3 (0.2) (0.0, 0.6) .050
Talking Kindly to Self After Setback 0.7 (0.1) 0.2 (0.1) 0.5 (0.2) (0.2, 0.9) .005
Arranging Healthy Foods for Easy Access 1.1 (0.2) 0.4 (0.1) 0.7 (0.2) (0.2, 1.1) .003
Frequency of Fried Foods -0.7 (0.1) -0.3 (0.1) -0.4 (0.2) (-0.8, -0.1) .013
Frequency of Sweets -1.3 (0.1) -0.5 (0.1) -0.8 (0.2) (-1.2, -0.4) <.001
Frequency of Sugary Beverages -0.8 (0.1) -0.4 (0.1) -0.4 (0.2) (-0.8, -0.1) .021
Snacking When Not Hungry -0.8 (0.1) -0.5 (0.1) -0.3 (0.2) (-0.7, 0.1) .115
Unhealthy Grouped -0.9 (0.1) -0.4 (0.1) -0.5 (0.1) (-0.7, -0.2) <.001
Healthy Grouped 1.2 (0.1) 0.5 (0.1) 0.7 (0.1) (0.5, 0.9) <.001
# export to excel
save_etab5 <- table_lmm_one[-c(15),]
colnames(save_etab5) <- c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value")
save_etab5 <- rbind(c("Change in Dietary Quality Measures (including HEI subscores)", "", "", "", "", ""),
                   save_etab5[1:14,],
                   c("Change in Micro and Macro Nutrients", "", "", "", "", ""),
                   save_etab5[15:23,],
                   c("Weight Loss Measures", "", "", "", "", ""),
                   save_etab5[24:25,],
                   c("Change in Physical Activity", "", "", "", "", ""),
                   save_etab5[26:29,],
                   c("Change Self-Reported Sleep", "", "", "", "", ""),
                   save_etab5[30:32,],
                   c("Change in Habit Strength", "", "", "", "", ""),
                   save_etab5[33:47,]
                   )

Loss to Follow-up

This table exists in response to a reviewer request.

save_etab6 <- follow_up_tab %>%
  select(all_of(demographic_vars), group) %>% 
  table1(~ Age_years + Sex_bcf + Gender_grouped + Race2_bcf + Ethnicity_bcf + Income_grouped + Education_grouped + foodinsec | group, data = .,
       render.continuous = for.cont.variables1)
save_etab6
Weight Watchers - Completed
(N=162)
Weight Watchers - Lost to Follow-up
(N=25)
Control - Completed
(N=184)
Control - Lost to Follow-up
(N=5)
Overall
(N=376)
Age, years
Mean (SD) 48.4 (11.7) 42.1 (13.9) 47.9 (12.4) 46.6 (9.3) 47.7 (12.2)
Sex assigned at birth
Female 126 (77.8%) 23 (92.0%) 144 (78.3%) 5 (100%) 298 (79.3%)
Male 36 (22.2%) 2 (8.0%) 40 (21.7%) 0 (0%) 78 (20.7%)
Self-identified gender
Female 125 (77.2%) 21 (84.0%) 142 (77.2%) 5 (100%) 293 (77.9%)
Male 36 (22.2%) 3 (12.0%) 41 (22.3%) 0 (0%) 80 (21.3%)
Non-binary / third gender / Transgender 1 (0.6%) 1 (4.0%) 1 (0.5%) 0 (0%) 3 (0.8%)
Self-identified race
Asian 8 (4.9%) 6 (24.0%) 14 (7.6%) 0 (0%) 28 (7.4%)
Black or African-American 21 (13.0%) 3 (12.0%) 28 (15.2%) 0 (0%) 52 (13.8%)
White 123 (75.9%) 16 (64.0%) 130 (70.7%) 3 (60.0%) 272 (72.3%)
Native Hawaiian or other Pacific Islander, Multiracial, Other or Prefer not to say 10 (6.2%) 0 (0%) 12 (6.5%) 2 (40.0%) 24 (6.4%)
Self-identified as Hispanic, Latinx, Latine, or Spanish
No 152 (93.8%) 24 (96.0%) 159 (86.4%) 5 (100%) 340 (90.4%)
Yes 10 (6.2%) 1 (4.0%) 25 (13.6%) 0 (0%) 36 (9.6%)
Household Income, USD
$59,999 or under 48 (29.6%) 4 (16.0%) 44 (23.9%) 3 (60.0%) 99 (26.3%)
Between $60,000 and $99,999 52 (32.1%) 8 (32.0%) 63 (34.2%) 0 (0%) 123 (32.7%)
$100,000 or above 62 (38.3%) 13 (52.0%) 77 (41.8%) 2 (40.0%) 154 (41.0%)
Highest level of education achieved
Associate degree or below 47 (29.0%) 6 (24.0%) 60 (32.6%) 3 (60.0%) 116 (30.9%)
Bachelor’s degree and some graduate school 59 (36.4%) 13 (52.0%) 60 (32.6%) 1 (20.0%) 133 (35.4%)
Masters or above 56 (34.6%) 6 (24.0%) 64 (34.8%) 1 (20.0%) 127 (33.8%)
Food insecurity
No 125 (77.2%) 0 (0%) 135 (73.4%) 0 (0%) 260 (69.1%)
Yes 27 (16.7%) 0 (0%) 40 (21.7%) 0 (0%) 67 (17.8%)
Missing 10 (6.2%) 25 (100%) 9 (4.9%) 5 (100%) 49 (13.0%)
save_etab7 <- follow_up_tab %>%
  select(all_of(outcome_vars), group) %>%
  tbl_summary(by = group, 
              missing = "no", 
              statistic = list(all_continuous() ~ "{mean} ({sd})",
                               all_categorical() ~ "{n} ({p}%)"),
              type = list(sleep_amount_bl ~ "continuous"),
              digits = list(everything() ~ c(1)),
              label = label_list) %>%
  add_overall(last = TRUE) %>%
  modify_header(label = "**Baseline Outcomes**") %>%
  bold_labels()
save_etab7
Baseline Outcomes Weight Watchers - Completed
N = 162
1
Weight Watchers - Lost to Follow-up
N = 25
1
Control - Completed
N = 184
1
Control - Lost to Follow-up
N = 5
1
Overall
N = 376
1
HEI Total Score 55.5 (12.4) 54.2 (11.6) 55.1 (12.5) 58.4 (13.0) 55.3 (12.3)
Total Vegetable 3.8 (1.3) 3.7 (1.3) 3.7 (1.3) 3.7 (1.0) 3.7 (1.3)
Greens and Beans 3.1 (2.0) 3.5 (1.7) 2.9 (2.0) 3.2 (2.2) 3.0 (2.0)
Total Fruit 2.0 (1.8) 2.0 (1.9) 2.0 (1.8) 2.2 (2.5) 2.0 (1.8)
Whole Fruit 2.6 (2.1) 2.5 (2.0) 2.6 (2.1) 2.5 (2.4) 2.6 (2.1)
Whole Grains 3.2 (3.2) 2.6 (2.7) 3.0 (3.0) 2.3 (2.2) 3.0 (3.1)
Total Dairy 5.4 (2.8) 5.1 (2.5) 5.7 (2.8) 5.1 (3.1) 5.5 (2.8)
Total Protein Foods 4.7 (0.8) 4.6 (0.9) 4.7 (0.8) 4.7 (0.5) 4.7 (0.8)
Seafood and Plant Proteins 3.6 (1.9) 3.6 (2.0) 3.5 (2.0) 4.0 (2.2) 3.5 (1.9)
Fatty Acids 4.8 (3.4) 4.8 (3.2) 4.7 (3.0) 7.4 (3.1) 4.8 (3.2)
Sodium 3.1 (2.9) 2.5 (2.4) 3.3 (2.8) 2.8 (3.6) 3.1 (2.8)
Refined Grains 6.7 (3.0) 6.8 (2.6) 6.9 (2.9) 6.5 (4.2) 6.8 (2.9)
Saturated Fats 4.2 (3.2) 4.9 (3.4) 4.1 (3.0) 5.2 (1.8) 4.2 (3.1)
Added Sugars 8.4 (2.0) 7.7 (2.8) 8.1 (2.3) 8.7 (2.0) 8.2 (2.2)
Average Total Energy 1,960.9 (609.4) 1,846.0 (672.1) 2,057.8 (724.8) 1,653.9 (692.2) 1,996.6 (674.7)
Average Total Fat 85.6 (30.7) 76.3 (30.4) 90.9 (36.2) 75.4 (24.1) 87.4 (33.6)
Average Total Carbohydrates 208.4 (80.1) 206.4 (94.3) 216.5 (85.2) 173.9 (99.0) 211.8 (83.7)
Average Sodium 3,459.2 (1,148.2) 3,292.3 (1,021.4) 3,569.3 (1,390.2) 2,974.6 (1,539.2) 3,495.5 (1,269.2)
Average Saturated Fats 28.3 (12.0) 25.2 (11.6) 29.6 (12.4) 21.6 (9.2) 28.6 (12.2)
Average Total Sugars 77.8 (40.5) 83.4 (54.5) 85.2 (42.5) 61.4 (25.1) 81.6 (42.4)
Average Added Sugars 11.4 (8.2) 13.0 (11.1) 12.6 (8.3) 8.9 (4.5) 12.1 (8.5)
Average Total Cholesterol 324.3 (175.1) 302.2 (129.6) 342.7 (194.0) 312.4 (188.6) 331.7 (182.0)
Average Fiber 17.8 (7.9) 15.1 (5.0) 17.9 (8.8) 15.4 (9.7) 17.6 (8.2)
Body Weight (kg) 95.4 (17.3) 88.9 (14.4) 95.2 (17.1) 87.6 (7.7) 94.8 (17.0)
BMI 33.7 (4.6) 33.1 (4.4) 33.7 (4.8) 32.7 (4.0) 33.6 (4.7)
Total Physical Activity MET 1,933.5 (3,091.1) 1,305.6 (1,709.0) 1,694.4 (2,458.6) 1,080.0 (1,247.1) 1,763.4 (2,700.1)
Sedentary 501.0 (225.1) 457.6 (266.6) 485.6 (222.3) 756.0 (316.4) 494.0 (229.2)
Moderate 1,139.0 (1,698.0) 923.2 (1,422.9) 1,060.1 (1,872.5) 600.0 (777.7) 1,078.8 (1,758.2)
Vigorous 794.6 (2,223.8) 382.4 (838.9) 634.3 (1,215.2) 480.0 (831.4) 684.6 (1,705.7)
Sleep Quality 2.4 (0.8) 2.4 (0.8) 2.4 (0.7) 2.2 (0.5) 2.4 (0.7)
Usual Sleep Amount 2.0 (0.3) 2.0 (0.2) 2.0 (0.3) 1.9 (0.4) 2.0 (0.3)
Wake Episodes 1.4 (1.2) 1.2 (0.9) 1.3 (1.2) 1.5 (1.3) 1.3 (1.1)
SRBAI Habit Strength 3.3 (0.9) 3.0 (0.9) 3.3 (0.8) 3.9 (0.9) 3.3 (0.9)
Considering Portion Sizes 3.8 (1.8) 3.1 (1.8) 3.7 (1.7) 5.0 (1.7) 3.8 (1.8)
Tracking Food Consumption 2.1 (1.7) 1.7 (1.1) 1.9 (1.6) 3.6 (2.3) 2.0 (1.6)
Consider WW Points 0.6 (1.4) 0.5 (1.1) 0.7 (1.5) 0.0 (0.0) 0.6 (1.4)
Frequency of Eating Vegetables 4.8 (1.6) 4.7 (1.7) 4.8 (1.7) 5.1 (1.8) 4.8 (1.7)
Frequency of Weighing Self 3.4 (2.1) 3.1 (1.8) 3.3 (2.1) 2.3 (1.9) 3.3 (2.1)
Frequency of Physical Activity 3.6 (1.6) 3.4 (1.8) 3.6 (1.8) 3.8 (2.3) 3.6 (1.7)
Talking Kindly to Self After Setback 3.0 (1.9) 3.0 (1.8) 3.3 (2.0) 4.5 (2.2) 3.2 (2.0)
Arranging Healthy Foods for Easy Access 3.2 (2.2) 2.4 (2.1) 3.1 (2.2) 5.9 (1.4) 3.1 (2.2)
Frequency of Fried Foods 3.5 (1.9) 3.9 (1.9) 3.4 (1.9) 2.6 (2.5) 3.4 (1.9)
Frequency of Sweets 4.5 (1.8) 4.8 (2.1) 4.5 (1.9) 4.9 (2.4) 4.5 (1.8)
Frequency of Sugary Beverages 2.3 (2.3) 3.3 (2.4) 2.5 (2.4) 1.4 (2.5) 2.5 (2.3)
Snacking When Not Hungry 4.6 (1.9) 4.4 (1.8) 4.6 (1.9) 4.1 (2.3) 4.6 (1.9)
Unhealthy Grouped 3.7 (1.4) 4.1 (1.4) 3.7 (1.4) 3.2 (1.3) 3.7 (1.4)
Healthy Grouped 3.1 (1.0) 2.7 (1.0) 3.1 (1.0) 3.8 (0.8) 3.1 (1.0)
1 Mean (SD)
save_etab6 <- as.data.frame(save_etab6, stringsAsFactors = FALSE)
rownames(save_etab6) = NULL

save_etab7 <- save_etab7 %>% gtsummary::as_tibble()
rownames(save_etab7) = NULL
# Clean up the column names
colnames(save_etab7) <- gsub("^\\*\\*", "", colnames(save_etab7))
colnames(save_etab7) <- gsub("\\n", "", colnames(save_etab7))
colnames(save_etab7) <- gsub("\\*\\* | \\*\\*|\\*\\*$", "", colnames(save_etab7))
colnames(save_etab7)  <- gsub("N = (\\d+)", "(N = \\1)", colnames(save_etab7))
# Clean up the variable names
save_etab7$`Baseline Outcomes` <- gsub("|__", "", save_etab7$`Baseline Outcomes`)


Dropout one decimal

This table exists in response to a reviewer request.

# Combine Mean (SE) and format p-values
table_dropout_one <- output_lmm_raw %>% dplyr::select(outcome_labels, group1_mean, group1_se, group2_mean, group2_se, diff_mean, 
                                                  diff_LB, diff_UB, diff_se, diff_p) %>%
  dplyr::rename(p_value = diff_p) %>%
  reframe(Outcome = outcome_labels, 
          WW = paste0(formatC(group1_mean, digits = 1, format = "f"), " (", 
                      formatC(group1_se, digits = 1, format = "f"),  ")"),
          Control = paste0(formatC(group2_mean, digits = 1, format = "f"), " (", 
                           formatC(group2_se, digits = 1, format = "f"),  ")"),
          Diff = paste0(formatC(diff_mean, digits = 1, format = "f"), " (", 
                        formatC(diff_se, digits = 1, format = "f"),  ")"),
          diff_CI = paste0("(", formatC(diff_LB, digits = 1, format = "f"), ", ", 
                           formatC(diff_UB, digits = 1, format = "f"), ")"),
          p_value_journal = case_when(
            p_value < 0.001 ~ "<.001",
            p_value > 0.001 & p_value < 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value >= 0.01 ~ leading_zeros(formatC(p_value, digits = 3, format = "f")),
            p_value > 0.99 ~ ">.99")
  )

# reorder for grouping
table_dropout_one <- table_dropout_one[match(setdiff(outcome_pairs$outcome_labels, c("Percent Body Weight Change", "Achieved 3% Weight Loss", "Achieved 5% Weight Loss", "Achieved 10% Weight Loss")), table_dropout_one$Outcome), ]

# remove negative sign in instances of -0.0
table_dropout_one <- change_negative_zero(table_dropout_one)

rownames(table_dropout_one) <- NULL

kable(table_dropout_one,
      caption = "Sensitivity Dropout Analysis (N=376)", 
      col.names = c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  kable_minimal() %>%
  add_header_above(c(" " = 1,  "Sensitivity Analysis (Dropout LMM)" = 5)) %>%
  pack_rows(index = c("Change in Dietary Quality Measures (including HEI subscores)" = 15,
                      "Change in Micro and Macro Nutrients" = 9,
                      "Weight Loss Measures" = 6-4,
                      "Change in Physical Activity" = 4,
                      "Change Self-Reported Sleep" = 3,
                      "Change in Habit Strength" = 15))
Sensitivity Dropout Analysis (N=376)
Sensitivity Analysis (Dropout LMM)
Outcome WW Mean (SE) Control Mean (SE) Mean Difference (SE) 95% CI of Mean Difference p-value
Change in Dietary Quality Measures (including HEI subscores)
HEI Total Score 3.9 (0.9) -0.1 (0.9) 4.0 (1.3) (1.4, 6.5) .002
Total Vegetable 0.2 (0.1) 0.1 (0.1) 0.1 (0.1) (-0.2, 0.4) .425
Greens and Beans 0.5 (0.2) 0.0 (0.2) 0.5 (0.2) (0.1, 1.0) .027
Total Fruit 0.5 (0.1) 0.0 (0.1) 0.5 (0.2) (0.1, 0.9) .007
Whole Fruit 0.4 (0.2) -0.1 (0.1) 0.5 (0.2) (0.1, 0.9) .028
Whole Grains 0.3 (0.3) 0.0 (0.3) 0.3 (0.4) (-0.4, 1.0) .445
Total Dairy -0.2 (0.2) -0.1 (0.2) -0.1 (0.3) (-0.7, 0.6) .862
Total Protein Foods 0.1 (0.1) 0.1 (0.1) 0.1 (0.1) (-0.1, 0.2) .490
Seafood and Plant Proteins -0.2 (0.2) -0.2 (0.2) 0.0 (0.2) (-0.5, 0.4) .889
Fatty Acids 0.6 (0.3) 0.3 (0.3) 0.3 (0.4) (-0.4, 1.0) .399
Sodium -0.6 (0.2) -0.6 (0.2) 0.0 (0.3) (-0.6, 0.6) .924
Refined Grains 0.8 (0.3) -0.5 (0.3) 1.2 (0.4) (0.5, 2.0) <.001
Saturated Fats 1.1 (0.3) 0.5 (0.2) 0.5 (0.4) (-0.2, 1.2) .133
Added Sugars 0.4 (0.2) 0.4 (0.2) 0.1 (0.2) (-0.4, 0.5) .741
AMED Score -0.1 (0.4) -0.5 (0.4) 0.4 (0.5) (-0.6, 1.5) .433
Change in Micro and Macro Nutrients
Average Total Energy -420.2 (43.9) -244.4 (42.4) -175.7 (61.1) (-295.8, -55.7) .004
Average Total Fat -21.2 (2.3) -11.6 (2.2) -9.7 (3.2) (-16.1, -3.3) .003
Average Total Carbohydrates -46.8 (5.2) -28.1 (5.0) -18.7 (7.3) (-32.9, -4.4) .010
Average Sodium -577.7 (80.6) -267.6 (77.8) -310.0 (112.0) (-530.3, -89.7) .006
Average Saturated Fats -7.6 (0.9) -4.1 (0.9) -3.4 (1.3) (-5.9, -1.0) .006
Average Total Sugars -17.7 (2.9) -14.5 (2.8) -3.3 (4.0) (-11.1, 4.6) .414
Average Added Sugars -3.8 (0.6) -2.6 (0.6) -1.1 (0.8) (-2.8, 0.5) .169
Average Total Cholesterol -39.5 (13.3) -23.4 (12.8) -16.1 (18.5) (-52.5, 20.3) .385
Average Fiber -2.1 (0.6) -1.9 (0.5) -0.2 (0.8) (-1.7, 1.3) .825
Weight Loss Measures
Body Weight (kg) -5.4 (0.4) -1.5 (0.4) -4.0 (0.6) (-5.2, -2.8) <.001
BMI -1.9 (0.2) -0.5 (0.1) -1.4 (0.2) (-1.8, -1.0) <.001
Change in Physical Activity
Total Physical Activity MET 497.7 (199.1) 564.6 (191.0) -66.9 (275.9) (-609.5, 475.6) .808
Sedentary -68.2 (14.3) -33.9 (13.7) -34.3 (19.8) (-73.2, 4.6) .084
Moderate 177.5 (133.1) 203.9 (127.7) -26.4 (184.4) (-389.1, 336.3) .886
Vigorous 329.5 (131.0) 362.1 (125.6) -32.6 (181.5) (-389.4, 324.3) .858
Change Self-Reported Sleep
Sleep Quality -0.1 (0.1) 0.2 (0.1) -0.2 (0.1) (-0.4, -0.1) .003
Usual Sleep Amount 0.0 (0.0) 0.1 (0.0) -0.1 (0.0) (-0.2, 0.0) .018
Wake Episodes 0.0 (0.1) 0.0 (0.1) 0.0 (0.1) (-0.2, 0.2) .937
Change in Habit Strength
SRBAI Habit Strength 0.8 (0.1) 0.3 (0.1) 0.5 (0.1) (0.4, 0.7) <.001
Considering Portion Sizes 1.1 (0.1) 0.7 (0.1) 0.5 (0.2) (0.1, 0.8) .008
Tracking Food Consumption 1.3 (0.1) 0.8 (0.1) 0.5 (0.2) (0.1, 0.9) .014
Consider WW Points 3.3 (0.1) 0.7 (0.1) 2.6 (0.2) (2.2, 3.0) <.001
Frequency of Eating Vegetables 0.6 (0.1) 0.3 (0.1) 0.3 (0.2) (0.0, 0.6) .081
Frequency of Weighing Self 1.0 (0.1) 0.4 (0.1) 0.6 (0.2) (0.2, 0.9) .001
Frequency of Physical Activity 0.7 (0.1) 0.4 (0.1) 0.3 (0.2) (0.0, 0.6) .050
Talking Kindly to Self After Setback 0.7 (0.1) 0.2 (0.1) 0.5 (0.2) (0.2, 0.9) .005
Arranging Healthy Foods for Easy Access 1.1 (0.2) 0.4 (0.1) 0.7 (0.2) (0.2, 1.1) .003
Frequency of Fried Foods -0.7 (0.1) -0.3 (0.1) -0.4 (0.2) (-0.8, -0.1) .013
Frequency of Sweets -1.3 (0.1) -0.5 (0.1) -0.8 (0.2) (-1.2, -0.4) <.001
Frequency of Sugary Beverages -0.8 (0.1) -0.4 (0.1) -0.4 (0.2) (-0.8, -0.1) .021
Snacking When Not Hungry -0.8 (0.1) -0.5 (0.1) -0.3 (0.2) (-0.7, 0.1) .115
Unhealthy Grouped -0.9 (0.1) -0.4 (0.1) -0.5 (0.1) (-0.7, -0.2) <.001
Healthy Grouped 1.2 (0.1) 0.5 (0.1) 0.7 (0.1) (0.5, 0.9) <.001
# export to excel
save_etab8 <- table_dropout_one[-c(15),]
colnames(save_etab8) <- c("Outcome", "WW Mean (SE)", "Control Mean (SE)", "Mean Difference (SE)", 
                    "95% CI of Mean Difference", "p-value")
save_etab8 <- rbind(c("Change in Dietary Quality Measures (including HEI subscores)", "", "", "", "", ""),
                   save_etab8[1:14,],
                   c("Change in Micro and Macro Nutrients", "", "", "", "", ""),
                   save_etab8[15:23,],
                   c("Weight Loss Measures", "", "", "", "", ""),
                   save_etab8[24:25,],
                   c("Change in Physical Activity", "", "", "", "", ""),
                   save_etab8[26:29,],
                   c("Change Self-Reported Sleep", "", "", "", "", ""),
                   save_etab8[30:32,],
                   c("Change in Habit Strength", "", "", "", "", ""),
                   save_etab8[33:47,]
                   )


References

Allison, P. (2009). Missing data. In The SAGE Handbook of Quantitative Methods in Psychology (pp. 72-90). SAGE Publications Ltd, https://doi.org/10.4135/9780857020994

Austin, P. C., White, I. R., Lee, D. S., & van Buuren, S. (2021). Missing Data in Clinical Research: A Tutorial on Multiple Imputation. The Canadian journal of cardiology, 37(9), 1322–1331. https://doi.org/10.1016/j.cjca.2020.11.010

Blanca MJ, Alarcón R, Arnau J, Bono R, Bendayan R. Effect of variance ratio on ANOVA robustness: Might 1.5 be the limit? Behav Res Methods 2018;50(3):937-62. doi: 10.3758/s13428-017-0918-2.

Casella G, Berger R. Statistical Inference. Second ed. USA, 2021.

Glass G, Hopkins KD. Statistical methods in psychology and education. Third ed. Needham Heights, MA: Allyn & Bacon, 1996.

Glass, G.V., Peckham, P.D., & Sanders, J.R. (1972). Consequences of Failure to Meet Assumptions Underlying the Fixed Effects Analyses of Variance and Covariance. Review of Educational Research, 42, 237 - 288. https://doi.org/10.3102/00346543042003237

Hardt, J., Herke, M. & Leonhart, R. Auxiliary variables in multiple imputation in regression with missing X: a warning against including too many in small sample research. BMC Med Res Methodol 12, 184 (2012). https://doi.org/10.1186/1471-2288-12-184

Lenth R (2023). emmeans: Estimated Marginal Means, aka Least-Squares Means. R package version 1.8.9, https://CRAN.R-project.org/package=emmeans

Madley-Dowd, P., Curnow, E., Hughes, R.A., Cornish, R., Tilling, K., Heron, J. “Analyses Using Multiple Imputation Need to Consider Missing Data in Auxiliary Variables.” MedRxiv (Cold Spring Harbor Laboratory), 11 Dec. 2023, https://doi.org/10.1101/2023.12.11.23299810.

Schulz KF, Altman DG, Moher D. CONSORT 2010 statement: updated guidelines for reporting parallel group randomized trials. Ann Intern Med 2010;152(11):726-32. doi: 10.7326/0003-4819-152-11-201006010-00232.

Stef van Buuren, Karin Groothuis-Oudshoorn (2011). mice: Multivariate Imputation by Chained Equations in R. Journal of Statistical Software, 45(3), 1-67. DOI 10.18637/jss.v045.i03.

von Hippel, Paul T. “How Many Imputations Do You Need? A Two-stage Calculation Using a Quadratic Rule.” Sociological Methods & Research. 2020;49(3):699-718. doi:10.1177/0049124117747303

Wilcox, R. R., & Rousselet, G. A. (2023). An updated guide to robust statistical methods in neuroscience. Current Protocols, 3, e719. doi: 10.1002/cpz1.719 https://currentprotocols.onlinelibrary.wiley.com/doi/epdf/10.1002/cpz1.719

Wrzecionkowska, D. & Calleja, N. (2022). Impact of Weight on Quality-of-Life Questionnaire-Lite, Mexican Version. Reliability and Validity Evidence. Revista de Psicología, 31(1), 1-13. http://dx.doi.org/10.5354/0719-0581.2022.64335